{-# OPTIONS_GHC -Wall #-}
module Numeric.GSL.SimulatedAnnealing (
simanSolve
, SimulatedAnnealingParams(..)
) where
import Numeric.GSL.Internal
import Numeric.LinearAlgebra.HMatrix hiding(step)
import Data.Vector.Storable(generateM)
import Foreign.Storable(Storable(..))
import Foreign.Marshal.Utils(with)
import Foreign.Ptr(Ptr, FunPtr, nullFunPtr)
import Foreign.StablePtr(StablePtr, newStablePtr, deRefStablePtr, freeStablePtr)
import Foreign.C.Types
import System.IO.Unsafe(unsafePerformIO)
import System.IO (hFlush, stdout)
import Data.IORef (IORef, newIORef, writeIORef, readIORef, modifyIORef')
data SimulatedAnnealingParams = SimulatedAnnealingParams {
SimulatedAnnealingParams -> CInt
n_tries :: CInt
, SimulatedAnnealingParams -> CInt
iters_fixed_T :: CInt
, SimulatedAnnealingParams -> Double
step_size :: Double
, SimulatedAnnealingParams -> Double
boltzmann_k :: Double
, SimulatedAnnealingParams -> Double
cooling_t_initial :: Double
, SimulatedAnnealingParams -> Double
cooling_mu_t :: Double
, SimulatedAnnealingParams -> Double
cooling_t_min :: Double
} deriving (SimulatedAnnealingParams -> SimulatedAnnealingParams -> Bool
(SimulatedAnnealingParams -> SimulatedAnnealingParams -> Bool)
-> (SimulatedAnnealingParams -> SimulatedAnnealingParams -> Bool)
-> Eq SimulatedAnnealingParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimulatedAnnealingParams -> SimulatedAnnealingParams -> Bool
== :: SimulatedAnnealingParams -> SimulatedAnnealingParams -> Bool
$c/= :: SimulatedAnnealingParams -> SimulatedAnnealingParams -> Bool
/= :: SimulatedAnnealingParams -> SimulatedAnnealingParams -> Bool
Eq, Int -> SimulatedAnnealingParams -> ShowS
[SimulatedAnnealingParams] -> ShowS
SimulatedAnnealingParams -> String
(Int -> SimulatedAnnealingParams -> ShowS)
-> (SimulatedAnnealingParams -> String)
-> ([SimulatedAnnealingParams] -> ShowS)
-> Show SimulatedAnnealingParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimulatedAnnealingParams -> ShowS
showsPrec :: Int -> SimulatedAnnealingParams -> ShowS
$cshow :: SimulatedAnnealingParams -> String
show :: SimulatedAnnealingParams -> String
$cshowList :: [SimulatedAnnealingParams] -> ShowS
showList :: [SimulatedAnnealingParams] -> ShowS
Show, ReadPrec [SimulatedAnnealingParams]
ReadPrec SimulatedAnnealingParams
Int -> ReadS SimulatedAnnealingParams
ReadS [SimulatedAnnealingParams]
(Int -> ReadS SimulatedAnnealingParams)
-> ReadS [SimulatedAnnealingParams]
-> ReadPrec SimulatedAnnealingParams
-> ReadPrec [SimulatedAnnealingParams]
-> Read SimulatedAnnealingParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SimulatedAnnealingParams
readsPrec :: Int -> ReadS SimulatedAnnealingParams
$creadList :: ReadS [SimulatedAnnealingParams]
readList :: ReadS [SimulatedAnnealingParams]
$creadPrec :: ReadPrec SimulatedAnnealingParams
readPrec :: ReadPrec SimulatedAnnealingParams
$creadListPrec :: ReadPrec [SimulatedAnnealingParams]
readListPrec :: ReadPrec [SimulatedAnnealingParams]
Read)
instance Storable SimulatedAnnealingParams where
sizeOf :: SimulatedAnnealingParams -> Int
sizeOf SimulatedAnnealingParams
p = CInt -> Int
forall a. Storable a => a -> Int
sizeOf (SimulatedAnnealingParams -> CInt
n_tries SimulatedAnnealingParams
p) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
CInt -> Int
forall a. Storable a => a -> Int
sizeOf (SimulatedAnnealingParams -> CInt
iters_fixed_T SimulatedAnnealingParams
p) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
Double -> Int
forall a. Storable a => a -> Int
sizeOf (SimulatedAnnealingParams -> Double
step_size SimulatedAnnealingParams
p) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
Double -> Int
forall a. Storable a => a -> Int
sizeOf (SimulatedAnnealingParams -> Double
boltzmann_k SimulatedAnnealingParams
p) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
Double -> Int
forall a. Storable a => a -> Int
sizeOf (SimulatedAnnealingParams -> Double
cooling_t_initial SimulatedAnnealingParams
p) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
Double -> Int
forall a. Storable a => a -> Int
sizeOf (SimulatedAnnealingParams -> Double
cooling_mu_t SimulatedAnnealingParams
p) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
Double -> Int
forall a. Storable a => a -> Int
sizeOf (SimulatedAnnealingParams -> Double
cooling_t_min SimulatedAnnealingParams
p)
alignment :: SimulatedAnnealingParams -> Int
alignment SimulatedAnnealingParams
p = Double -> Int
forall a. Storable a => a -> Int
alignment (SimulatedAnnealingParams -> Double
step_size SimulatedAnnealingParams
p)
peek :: Ptr SimulatedAnnealingParams -> IO SimulatedAnnealingParams
peek Ptr SimulatedAnnealingParams
ptr = CInt
-> CInt
-> Double
-> Double
-> Double
-> Double
-> Double
-> SimulatedAnnealingParams
SimulatedAnnealingParams (CInt
-> CInt
-> Double
-> Double
-> Double
-> Double
-> Double
-> SimulatedAnnealingParams)
-> IO CInt
-> IO
(CInt
-> Double
-> Double
-> Double
-> Double
-> Double
-> SimulatedAnnealingParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Ptr SimulatedAnnealingParams -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr SimulatedAnnealingParams
ptr Int
0 IO
(CInt
-> Double
-> Double
-> Double
-> Double
-> Double
-> SimulatedAnnealingParams)
-> IO CInt
-> IO
(Double
-> Double
-> Double
-> Double
-> Double
-> SimulatedAnnealingParams)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
Ptr SimulatedAnnealingParams -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr SimulatedAnnealingParams
ptr Int
i IO
(Double
-> Double
-> Double
-> Double
-> Double
-> SimulatedAnnealingParams)
-> IO Double
-> IO
(Double -> Double -> Double -> Double -> SimulatedAnnealingParams)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
Ptr SimulatedAnnealingParams -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr SimulatedAnnealingParams
ptr (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i) IO
(Double -> Double -> Double -> Double -> SimulatedAnnealingParams)
-> IO Double
-> IO (Double -> Double -> Double -> SimulatedAnnealingParams)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
Ptr SimulatedAnnealingParams -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr SimulatedAnnealingParams
ptr (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) IO (Double -> Double -> Double -> SimulatedAnnealingParams)
-> IO Double -> IO (Double -> Double -> SimulatedAnnealingParams)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
Ptr SimulatedAnnealingParams -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr SimulatedAnnealingParams
ptr (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d) IO (Double -> Double -> SimulatedAnnealingParams)
-> IO Double -> IO (Double -> SimulatedAnnealingParams)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
Ptr SimulatedAnnealingParams -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr SimulatedAnnealingParams
ptr (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d) IO (Double -> SimulatedAnnealingParams)
-> IO Double -> IO SimulatedAnnealingParams
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
Ptr SimulatedAnnealingParams -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr SimulatedAnnealingParams
ptr (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d)
where
i :: Int
i = CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
0 :: CInt)
d :: Int
d = Double -> Int
forall a. Storable a => a -> Int
sizeOf (Double
0 :: Double)
poke :: Ptr SimulatedAnnealingParams -> SimulatedAnnealingParams -> IO ()
poke Ptr SimulatedAnnealingParams
ptr SimulatedAnnealingParams
sap = do
Ptr SimulatedAnnealingParams -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr SimulatedAnnealingParams
ptr Int
0 (SimulatedAnnealingParams -> CInt
n_tries SimulatedAnnealingParams
sap)
Ptr SimulatedAnnealingParams -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr SimulatedAnnealingParams
ptr Int
i (SimulatedAnnealingParams -> CInt
iters_fixed_T SimulatedAnnealingParams
sap)
Ptr SimulatedAnnealingParams -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr SimulatedAnnealingParams
ptr (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i) (SimulatedAnnealingParams -> Double
step_size SimulatedAnnealingParams
sap)
Ptr SimulatedAnnealingParams -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr SimulatedAnnealingParams
ptr (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) (SimulatedAnnealingParams -> Double
boltzmann_k SimulatedAnnealingParams
sap)
Ptr SimulatedAnnealingParams -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr SimulatedAnnealingParams
ptr (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d) (SimulatedAnnealingParams -> Double
cooling_t_initial SimulatedAnnealingParams
sap)
Ptr SimulatedAnnealingParams -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr SimulatedAnnealingParams
ptr (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d) (SimulatedAnnealingParams -> Double
cooling_mu_t SimulatedAnnealingParams
sap)
Ptr SimulatedAnnealingParams -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr SimulatedAnnealingParams
ptr (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d) (SimulatedAnnealingParams -> Double
cooling_t_min SimulatedAnnealingParams
sap)
where
i :: Int
i = CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
0 :: CInt)
d :: Int
d = Double -> Int
forall a. Storable a => a -> Int
sizeOf (Double
0 :: Double)
type P a = StablePtr (IORef a)
copyConfig :: P a -> P a -> IO ()
copyConfig :: forall a. P a -> P a -> IO ()
copyConfig P a
src' P a
dest' = do
IORef a
dest <- P a -> IO (IORef a)
forall a. StablePtr a -> IO a
deRefStablePtr P a
dest'
IORef a
src <- P a -> IO (IORef a)
forall a. StablePtr a -> IO a
deRefStablePtr P a
src'
IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
src IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
dest
copyConstructConfig :: P a -> IO (P a)
copyConstructConfig :: forall a. P a -> IO (P a)
copyConstructConfig P a
x = do
a
conf <- P a -> IO a
forall a. P a -> IO a
deRefRead P a
x
IORef a
newconf <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
conf
IORef a -> IO (P a)
forall a. a -> IO (StablePtr a)
newStablePtr IORef a
newconf
destroyConfig :: P a -> IO ()
destroyConfig :: forall a. P a -> IO ()
destroyConfig P a
p = do
P a -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr P a
p
deRefRead :: P a -> IO a
deRefRead :: forall a. P a -> IO a
deRefRead P a
p = P a -> IO (IORef a)
forall a. StablePtr a -> IO a
deRefStablePtr P a
p IO (IORef a) -> (IORef a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef a -> IO a
forall a. IORef a -> IO a
readIORef
wrapEnergy :: (a -> Double) -> P a -> Double
wrapEnergy :: forall a. (a -> Double) -> P a -> Double
wrapEnergy a -> Double
f P a
p = IO Double -> Double
forall a. IO a -> a
unsafePerformIO (IO Double -> Double) -> IO Double -> Double
forall a b. (a -> b) -> a -> b
$ a -> Double
f (a -> Double) -> IO a -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P a -> IO a
forall a. P a -> IO a
deRefRead P a
p
wrapMetric :: (a -> a -> Double) -> P a -> P a -> Double
wrapMetric :: forall a. (a -> a -> Double) -> P a -> P a -> Double
wrapMetric a -> a -> Double
f P a
x P a
y = IO Double -> Double
forall a. IO a -> a
unsafePerformIO (IO Double -> Double) -> IO Double -> Double
forall a b. (a -> b) -> a -> b
$ a -> a -> Double
f (a -> a -> Double) -> IO a -> IO (a -> Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P a -> IO a
forall a. P a -> IO a
deRefRead P a
x IO (a -> Double) -> IO a -> IO Double
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P a -> IO a
forall a. P a -> IO a
deRefRead P a
y
wrapStep :: Int
-> (Vector Double -> Double -> a -> a)
-> GSLRNG
-> P a
-> Double
-> IO ()
wrapStep :: forall a.
Int
-> (Vector Double -> Double -> a -> a)
-> GSLRNG
-> P a
-> Double
-> IO ()
wrapStep Int
nrand Vector Double -> Double -> a -> a
f (GSLRNG Ptr GSLRNG
rng) P a
confptr Double
stepSize = do
Vector Double
v <- Int -> (Int -> IO Double) -> IO (Vector Double)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> (Int -> m a) -> m (Vector a)
generateM Int
nrand (\Int
_ -> Ptr GSLRNG -> IO Double
gslRngUniform Ptr GSLRNG
rng)
IORef a
conf <- P a -> IO (IORef a)
forall a. StablePtr a -> IO a
deRefStablePtr P a
confptr
IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef a
conf ((a -> a) -> IO ()) -> (a -> a) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector Double -> Double -> a -> a
f Vector Double
v Double
stepSize
wrapPrint :: (a -> String) -> P a -> IO ()
wrapPrint :: forall a. (a -> String) -> P a -> IO ()
wrapPrint a -> String
pf P a
ptr = P a -> IO a
forall a. P a -> IO a
deRefRead P a
ptr IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
putStr (String -> IO ()) -> (a -> String) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
pf IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stdout
foreign import ccall safe "wrapper"
mkEnergyFun :: (P a -> Double) -> IO (FunPtr (P a -> Double))
foreign import ccall safe "wrapper"
mkMetricFun :: (P a -> P a -> Double) -> IO (FunPtr (P a -> P a -> Double))
foreign import ccall safe "wrapper"
mkStepFun :: (GSLRNG -> P a -> Double -> IO ())
-> IO (FunPtr (GSLRNG -> P a -> Double -> IO ()))
foreign import ccall safe "wrapper"
mkCopyFun :: (P a -> P a -> IO ()) -> IO (FunPtr (P a -> P a -> IO ()))
foreign import ccall safe "wrapper"
mkCopyConstructorFun :: (P a -> IO (P a)) -> IO (FunPtr (P a -> IO (P a)))
foreign import ccall safe "wrapper"
mkDestructFun :: (P a -> IO ()) -> IO (FunPtr (P a -> IO ()))
newtype GSLRNG = GSLRNG (Ptr GSLRNG)
foreign import ccall safe "gsl_rng.h gsl_rng_uniform"
gslRngUniform :: Ptr GSLRNG -> IO Double
foreign import ccall safe "gsl-aux.h siman"
siman :: CInt
-> Ptr SimulatedAnnealingParams
-> P a
-> FunPtr (P a -> Double)
-> FunPtr (P a -> P a -> Double)
-> FunPtr (GSLRNG -> P a -> Double -> IO ())
-> FunPtr (P a -> P a -> IO ())
-> FunPtr (P a -> IO (P a))
-> FunPtr (P a -> IO ())
-> FunPtr (P a -> IO ())
-> IO CInt
simanSolve :: Int
-> Int
-> SimulatedAnnealingParams
-> a
-> (a -> Double)
-> (a -> a -> Double)
-> (Vector Double -> Double -> a -> a)
-> Maybe (a -> String)
-> a
simanSolve :: forall a.
Int
-> Int
-> SimulatedAnnealingParams
-> a
-> (a -> Double)
-> (a -> a -> Double)
-> (Vector Double -> Double -> a -> a)
-> Maybe (a -> String)
-> a
simanSolve Int
seed Int
nrand SimulatedAnnealingParams
params a
conf a -> Double
e a -> a -> Double
m Vector Double -> Double -> a -> a
step Maybe (a -> String)
printfun =
IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ SimulatedAnnealingParams
-> (Ptr SimulatedAnnealingParams -> IO a) -> IO a
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with SimulatedAnnealingParams
params ((Ptr SimulatedAnnealingParams -> IO a) -> IO a)
-> (Ptr SimulatedAnnealingParams -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr SimulatedAnnealingParams
paramptr -> do
FunPtr (P a -> Double)
ewrap <- (P a -> Double) -> IO (FunPtr (P a -> Double))
forall a. (P a -> Double) -> IO (FunPtr (P a -> Double))
mkEnergyFun ((P a -> Double) -> IO (FunPtr (P a -> Double)))
-> (P a -> Double) -> IO (FunPtr (P a -> Double))
forall a b. (a -> b) -> a -> b
$ (a -> Double) -> P a -> Double
forall a. (a -> Double) -> P a -> Double
wrapEnergy a -> Double
e
FunPtr (P a -> P a -> Double)
mwrap <- (P a -> P a -> Double) -> IO (FunPtr (P a -> P a -> Double))
forall a.
(P a -> P a -> Double) -> IO (FunPtr (P a -> P a -> Double))
mkMetricFun ((P a -> P a -> Double) -> IO (FunPtr (P a -> P a -> Double)))
-> (P a -> P a -> Double) -> IO (FunPtr (P a -> P a -> Double))
forall a b. (a -> b) -> a -> b
$ (a -> a -> Double) -> P a -> P a -> Double
forall a. (a -> a -> Double) -> P a -> P a -> Double
wrapMetric a -> a -> Double
m
FunPtr (GSLRNG -> P a -> Double -> IO ())
stepwrap <- (GSLRNG -> P a -> Double -> IO ())
-> IO (FunPtr (GSLRNG -> P a -> Double -> IO ()))
forall a.
(GSLRNG -> P a -> Double -> IO ())
-> IO (FunPtr (GSLRNG -> P a -> Double -> IO ()))
mkStepFun ((GSLRNG -> P a -> Double -> IO ())
-> IO (FunPtr (GSLRNG -> P a -> Double -> IO ())))
-> (GSLRNG -> P a -> Double -> IO ())
-> IO (FunPtr (GSLRNG -> P a -> Double -> IO ()))
forall a b. (a -> b) -> a -> b
$ Int
-> (Vector Double -> Double -> a -> a)
-> GSLRNG
-> P a
-> Double
-> IO ()
forall a.
Int
-> (Vector Double -> Double -> a -> a)
-> GSLRNG
-> P a
-> Double
-> IO ()
wrapStep Int
nrand Vector Double -> Double -> a -> a
step
P a
confptr <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
conf IO (IORef a) -> (IORef a -> IO (P a)) -> IO (P a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef a -> IO (P a)
forall a. a -> IO (StablePtr a)
newStablePtr
FunPtr (P a -> P a -> IO ())
cpwrap <- (P a -> P a -> IO ()) -> IO (FunPtr (P a -> P a -> IO ()))
forall a.
(P a -> P a -> IO ()) -> IO (FunPtr (P a -> P a -> IO ()))
mkCopyFun P a -> P a -> IO ()
forall a. P a -> P a -> IO ()
copyConfig
FunPtr (P a -> IO (P a))
ccwrap <- (P a -> IO (P a)) -> IO (FunPtr (P a -> IO (P a)))
forall a. (P a -> IO (P a)) -> IO (FunPtr (P a -> IO (P a)))
mkCopyConstructorFun P a -> IO (P a)
forall a. P a -> IO (P a)
copyConstructConfig
FunPtr (P a -> IO ())
dwrap <- (P a -> IO ()) -> IO (FunPtr (P a -> IO ()))
forall a. (P a -> IO ()) -> IO (FunPtr (P a -> IO ()))
mkDestructFun P a -> IO ()
forall a. P a -> IO ()
destroyConfig
FunPtr (P a -> IO ())
pwrap <- case Maybe (a -> String)
printfun of
Maybe (a -> String)
Nothing -> FunPtr (P a -> IO ()) -> IO (FunPtr (P a -> IO ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr (P a -> IO ())
forall a. FunPtr a
nullFunPtr
Just a -> String
pf -> (P a -> IO ()) -> IO (FunPtr (P a -> IO ()))
forall a. (P a -> IO ()) -> IO (FunPtr (P a -> IO ()))
mkDestructFun ((P a -> IO ()) -> IO (FunPtr (P a -> IO ())))
-> (P a -> IO ()) -> IO (FunPtr (P a -> IO ()))
forall a b. (a -> b) -> a -> b
$ (a -> String) -> P a -> IO ()
forall a. (a -> String) -> P a -> IO ()
wrapPrint a -> String
pf
CInt
-> Ptr SimulatedAnnealingParams
-> P a
-> FunPtr (P a -> Double)
-> FunPtr (P a -> P a -> Double)
-> FunPtr (GSLRNG -> P a -> Double -> IO ())
-> FunPtr (P a -> P a -> IO ())
-> FunPtr (P a -> IO (P a))
-> FunPtr (P a -> IO ())
-> FunPtr (P a -> IO ())
-> IO CInt
forall a.
CInt
-> Ptr SimulatedAnnealingParams
-> P a
-> FunPtr (P a -> Double)
-> FunPtr (P a -> P a -> Double)
-> FunPtr (GSLRNG -> P a -> Double -> IO ())
-> FunPtr (P a -> P a -> IO ())
-> FunPtr (P a -> IO (P a))
-> FunPtr (P a -> IO ())
-> FunPtr (P a -> IO ())
-> IO CInt
siman (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
seed)
Ptr SimulatedAnnealingParams
paramptr P a
confptr
FunPtr (P a -> Double)
ewrap FunPtr (P a -> P a -> Double)
mwrap FunPtr (GSLRNG -> P a -> Double -> IO ())
stepwrap FunPtr (P a -> P a -> IO ())
cpwrap FunPtr (P a -> IO (P a))
ccwrap FunPtr (P a -> IO ())
dwrap FunPtr (P a -> IO ())
pwrap IO CInt -> (IO CInt -> IO ()) -> IO ()
forall x y. x -> (x -> y) -> y
// String -> IO CInt -> IO ()
check String
"siman"
a
result <- P a -> IO a
forall a. P a -> IO a
deRefRead P a
confptr
P a -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr P a
confptr
a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result