lbfgs 0.0.2 → 0.0.3

raw patch · 3 files changed

+17/−16 lines, 3 files

Files

• Numeric/LBFGS.hs +12/−12
• Numeric/LBFGS/Raw.hsc +4/−3
• lbfgs.cabal +1/−1

@@ -23,6 +23,8 @@ import Foreign.ForeignPtr (newForeignPtr_) import Foreign.Marshal.Alloc (malloc, free) import Foreign.Ptr (Ptr, freeHaskellFunPtr, nullPtr, plusPtr)+import Foreign.StablePtr (StablePtr, deRefStablePtr, newStablePtr,+                                   freeStablePtr) import Foreign.Storable (Storable(..), peek, poke, sizeOf)  import qualified Numeric.LBFGS.Raw as R@@ -160,7 +162,7 @@ freeVector = c_lbfgs_free  vectorToList :: CInt -> Ptr CDouble -> IO ([Double])-vectorToList cn p = vectorToList_ p (cDoublePlusPtr p n) []+vectorToList cn p = vectorToList_ p (cDoublePlusPtr p (n - 1)) []     where n = fromIntegral cn  vectorToList_ :: Ptr CDouble -> Ptr CDouble -> [Double] -> IO ([Double])@@ -183,11 +185,11 @@     -> CDouble                   -- ^ Step of the line search algorithm     -> IO (CDouble)              -- ^ Value of the objective function -wrapEvaluateFun :: (Storable a) => EvaluateFun a -> Ptr a -> Ptr CDouble ->+wrapEvaluateFun :: EvaluateFun a -> StablePtr a -> Ptr CDouble ->                    Ptr CDouble -> CInt -> CDouble -> IO (CDouble) wrapEvaluateFun fun inst x g n step = do   let nInt = fromIntegral n-  instV <- peek inst+  instV <- deRefStablePtr inst   xFp <- newForeignPtr_ x   xArr <- unsafeForeignPtrToStorableArray xFp (0, nInt - 1)   gFp <- newForeignPtr_ g@@ -213,12 +215,12 @@     -> IO (CInt)                 -- ^ Return zero to continue the evaluation,                                  --   non-zero otherwise -wrapProgressFun :: (Storable a) => ProgressFun a -> Ptr a -> Ptr CDouble ->+wrapProgressFun :: ProgressFun a -> StablePtr a -> Ptr CDouble ->                    Ptr CDouble-> CDouble -> CDouble -> CDouble -> CDouble ->                    CInt -> CInt -> CInt -> IO (CInt) wrapProgressFun fun inst x g fx xn gn step n k ls = do   let nInt = fromIntegral n-  instV <- peek inst+  instV <- deRefStablePtr inst   xFp <- newForeignPtr_ x   xArr <- unsafeForeignPtrToStorableArray xFp (0, nInt - 1)   gFp <- newForeignPtr_ g@@ -228,8 +230,7 @@ -- | -- Start a L-BFGS optimization. The initial variables should be -- provided as a list of doubles.-lbfgs :: (Storable a) =>-         LineSearchAlgorithm       -- ^ The line search algorithm+lbfgs :: LineSearchAlgorithm       -- ^ The line search algorithm       -> EvaluateFun a             -- ^ Objective function       -> ProgressFun a             -- ^ Progress report function       -> a                         -- ^ Instance data@@ -238,13 +239,12 @@ lbfgs ls evalFun progressFun inst p = lbfgs_ ls (wrapEvaluateFun evalFun)                                  (wrapProgressFun progressFun) inst p -lbfgs_ :: (Storable a) => LineSearchAlgorithm -> CEvaluateFun a ->-          CProgressFun a -> a -> [Double] -> IO(LBFGSResult, [Double])+lbfgs_ :: LineSearchAlgorithm -> CEvaluateFun a -> CProgressFun a -> a ->+          [Double] -> IO(LBFGSResult, [Double]) lbfgs_ ls evalFun progressFun inst p = do   (n, pVec) <- listToVector p   let param = withParam ls-  instP <- malloc-  poke instP inst+  instP <- newStablePtr inst   paramP <- malloc   poke paramP param   evalW <- c_lbfgs_evaluate_t_wrap evalFun@@ -253,7 +253,7 @@   freeHaskellFunPtr progressW   freeHaskellFunPtr evalW   free paramP-  free instP+  freeStablePtr instP   freeVector pVec   rl <- vectorToList n pVec   return (deriveResult $ CLBFGSResult r, rl)

@@ -55,6 +55,7 @@ import Foreign.Storable (Storable(..)) import Foreign.C.Types (CDouble, CInt) import Foreign.Ptr (FunPtr, Ptr)+import Foreign.StablePtr (StablePtr)  newtype CLineSearchAlgorithm =     CLineSearchAlgorithm { unCLineSearchAlgorithm :: CInt }@@ -161,10 +162,10 @@       (#poke lbfgs_parameter_t, orthantwise_start) ptr orthantwise_start       (#poke lbfgs_parameter_t, orthantwise_end) ptr orthantwise_end -type CEvaluateFun a = (Ptr a -> Ptr CDouble -> Ptr CDouble -> CInt ->+type CEvaluateFun a = (StablePtr a -> Ptr CDouble -> Ptr CDouble -> CInt ->                       CDouble -> IO (CDouble)) -type CProgressFun a = (Ptr a -> Ptr CDouble -> Ptr CDouble -> CDouble ->+type CProgressFun a = (StablePtr a -> Ptr CDouble -> Ptr CDouble -> CDouble ->                       CDouble -> CDouble -> CDouble -> CInt -> CInt ->                       CInt -> IO (CInt)) @@ -176,7 +177,7 @@  foreign import ccall safe "lbfgs.h lbfgs" c_lbfgs ::     CInt -> Ptr CDouble -> Ptr CDouble -> FunPtr (CEvaluateFun a) ->-    FunPtr (CProgressFun a) -> Ptr a -> Ptr (CLBFGSParameter) -> IO (CInt)+    FunPtr (CProgressFun a) -> StablePtr a -> Ptr (CLBFGSParameter) -> IO (CInt)  foreign import ccall unsafe "lbfgs.h lbfgs_malloc" c_lbfgs_malloc ::     CInt -> IO (Ptr CDouble)

@@ -1,5 +1,5 @@ Name:               lbfgs-Version:            0.0.2+Version:            0.0.3 License:            OtherLicense License-File:       LICENSE Copyright:          Daniël de Kok