module Optimize.ASA where
import Optimize.Parameter
import Foreign.C.Types
import Foreign.Storable
import Foreign.Ptr
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Random
import Data.Array.Unboxed
import Data.Int
newtype UserOptions = UserOptions (Ptr UserOptions)
type Doubles = UArray Int Double
data ExitCode = NormalExit | PTempTooSmall | CTempTooSmall | CostRepeating | TooManyInvalidStates | ImmediateExit | InvalidUserInput | InvalidCostFunction | InvalidCostFunctionDeriv
deriving(Eq,Ord,Enum,Show,Read)
data Results x = Results {
optimalValue :: Double,
optimalParam :: x,
exitCode :: ExitCode
}
type CostFunction = Ptr Double -> Ptr Int -> IO Double
foreign import ccall "wrapper" mkCostFunction :: CostFunction -> IO (FunPtr CostFunction)
foreign import ccall "asa_usr.h asa_main" asa_main :: FunPtr CostFunction -> CInt -> Ptr Double -> Ptr Double -> Ptr CInt -> Ptr Double -> Ptr Double -> Ptr CInt -> CInt -> IO CInt
asa :: UserOptions
-> (Doubles -> IO (Maybe Double))
-> Int64
-> Maybe Doubles
-> Doubles
-> Doubles
-> UArray Int Bool
-> IO (ExitCode,Doubles)
asa = undefined
toBasicCostFunction :: Parameter z x => z -> (x -> Double) -> CostFunction
toBasicCostFunction z fn = f where
thePeek = peekParam z
f pd pf = do
poke pf 1
x <- thePeek pd
let v = fn x
return $ v
minimize :: Parameter z x => z -> (x -> Double) -> IO x
minimize z (fn :: x -> Double ) = do
cf <- mkCostFunction (toBasicCostFunction z fn)
let n = numParams (undefined :: x) z
let ps = paramInfo (undefined :: x) z []
withArray (map limitLow ps) $ \lower_bounds -> do
withArray (map limitHigh ps) $ \upper_bounds -> do
withArray (map (\x -> if isIntegral x then (1) else (1)) ps) $ \real_int -> do
alloca $ \dummy_cost_val -> do
allocaArray n $ \ret -> do
alloca $ \exit_code -> do
r <- randomIO
asa_main cf (fromIntegral n) upper_bounds lower_bounds real_int dummy_cost_val ret exit_code (fromIntegral (r :: Int))
peekParam z ret