diff options
Diffstat (limited to 'lib/Numeric/GSL/Minimization.hs')
-rw-r--r-- | lib/Numeric/GSL/Minimization.hs | 31 |
1 files changed, 16 insertions, 15 deletions
diff --git a/lib/Numeric/GSL/Minimization.hs b/lib/Numeric/GSL/Minimization.hs index 98c0ca9..65705cc 100644 --- a/lib/Numeric/GSL/Minimization.hs +++ b/lib/Numeric/GSL/Minimization.hs | |||
@@ -24,6 +24,7 @@ module Numeric.GSL.Minimization ( | |||
24 | import Data.Packed.Internal | 24 | import Data.Packed.Internal |
25 | import Data.Packed.Matrix | 25 | import Data.Packed.Matrix |
26 | import Foreign | 26 | import Foreign |
27 | import Foreign.C.Types(CInt) | ||
27 | 28 | ||
28 | ------------------------------------------------------------------------- | 29 | ------------------------------------------------------------------------- |
29 | 30 | ||
@@ -85,7 +86,7 @@ minimizeNMSimplex f xi sz tol maxit = unsafePerformIO $ do | |||
85 | fp <- mkVecfun (iv (f.toList)) | 86 | fp <- mkVecfun (iv (f.toList)) |
86 | rawpath <- ww2 withVector xiv withVector szv $ \xiv' szv' -> | 87 | rawpath <- ww2 withVector xiv withVector szv $ \xiv' szv' -> |
87 | createMIO maxit (n+3) | 88 | createMIO maxit (n+3) |
88 | (c_minimizeNMSimplex fp tol maxit // xiv' // szv') | 89 | (c_minimizeNMSimplex fp tol (fromIntegral maxit) // xiv' // szv') |
89 | "minimizeNMSimplex" | 90 | "minimizeNMSimplex" |
90 | let it = round (rawpath @@> (maxit-1,0)) | 91 | let it = round (rawpath @@> (maxit-1,0)) |
91 | path = takeRows it rawpath | 92 | path = takeRows it rawpath |
@@ -95,7 +96,7 @@ minimizeNMSimplex f xi sz tol maxit = unsafePerformIO $ do | |||
95 | 96 | ||
96 | 97 | ||
97 | foreign import ccall "gsl-aux.h minimize" | 98 | foreign import ccall "gsl-aux.h minimize" |
98 | c_minimizeNMSimplex:: FunPtr (Int -> Ptr Double -> Double) -> Double -> Int | 99 | c_minimizeNMSimplex:: FunPtr (CInt -> Ptr Double -> Double) -> Double -> CInt |
99 | -> TVVM | 100 | -> TVVM |
100 | 101 | ||
101 | ---------------------------------------------------------------------------------- | 102 | ---------------------------------------------------------------------------------- |
@@ -151,7 +152,7 @@ minimizeConjugateGradient istep minimpar tol maxit f df xi = unsafePerformIO $ d | |||
151 | dfp <- mkVecVecfun (aux_vTov df') | 152 | dfp <- mkVecVecfun (aux_vTov df') |
152 | rawpath <- withVector xiv $ \xiv' -> | 153 | rawpath <- withVector xiv $ \xiv' -> |
153 | createMIO maxit (n+2) | 154 | createMIO maxit (n+2) |
154 | (c_minimizeConjugateGradient fp dfp istep minimpar tol maxit // xiv') | 155 | (c_minimizeConjugateGradient fp dfp istep minimpar tol (fromIntegral maxit) // xiv') |
155 | "minimizeDerivV" | 156 | "minimizeDerivV" |
156 | let it = round (rawpath @@> (maxit-1,0)) | 157 | let it = round (rawpath @@> (maxit-1,0)) |
157 | path = takeRows it rawpath | 158 | path = takeRows it rawpath |
@@ -162,36 +163,36 @@ minimizeConjugateGradient istep minimpar tol maxit f df xi = unsafePerformIO $ d | |||
162 | 163 | ||
163 | 164 | ||
164 | foreign import ccall "gsl-aux.h minimizeWithDeriv" | 165 | foreign import ccall "gsl-aux.h minimizeWithDeriv" |
165 | c_minimizeConjugateGradient :: FunPtr (Int -> Ptr Double -> Double) | 166 | c_minimizeConjugateGradient :: FunPtr (CInt -> Ptr Double -> Double) |
166 | -> FunPtr (Int -> Ptr Double -> Ptr Double -> IO ()) | 167 | -> FunPtr (CInt -> Ptr Double -> Ptr Double -> IO ()) |
167 | -> Double -> Double -> Double -> Int | 168 | -> Double -> Double -> Double -> CInt |
168 | -> TVM | 169 | -> TVM |
169 | 170 | ||
170 | --------------------------------------------------------------------- | 171 | --------------------------------------------------------------------- |
171 | iv :: (Vector Double -> Double) -> (Int -> Ptr Double -> Double) | 172 | iv :: (Vector Double -> Double) -> (CInt -> Ptr Double -> Double) |
172 | iv f n p = f (createV n copy "iv") where | 173 | iv f n p = f (createV (fromIntegral n) copy "iv") where |
173 | copy n' q = do | 174 | copy n' q = do |
174 | copyArray q p n' | 175 | copyArray q p n' |
175 | return 0 | 176 | return 0 |
176 | 177 | ||
177 | -- | conversion of Haskell functions into function pointers that can be used in the C side | 178 | -- | conversion of Haskell functions into function pointers that can be used in the C side |
178 | foreign import ccall "wrapper" | 179 | foreign import ccall "wrapper" |
179 | mkVecfun :: (Int -> Ptr Double -> Double) | 180 | mkVecfun :: (CInt -> Ptr Double -> Double) |
180 | -> IO( FunPtr (Int -> Ptr Double -> Double)) | 181 | -> IO( FunPtr (CInt -> Ptr Double -> Double)) |
181 | 182 | ||
182 | -- | another required conversion | 183 | -- | another required conversion |
183 | foreign import ccall "wrapper" | 184 | foreign import ccall "wrapper" |
184 | mkVecVecfun :: (Int -> Ptr Double -> Ptr Double -> IO ()) | 185 | mkVecVecfun :: (CInt -> Ptr Double -> Ptr Double -> IO ()) |
185 | -> IO (FunPtr (Int -> Ptr Double -> Ptr Double->IO())) | 186 | -> IO (FunPtr (CInt -> Ptr Double -> Ptr Double->IO())) |
186 | 187 | ||
187 | aux_vTov :: (Vector Double -> Vector Double) -> (Int -> Ptr Double -> Ptr Double -> IO()) | 188 | aux_vTov :: (Vector Double -> Vector Double) -> (CInt -> Ptr Double -> Ptr Double -> IO()) |
188 | aux_vTov f n p r = g where | 189 | aux_vTov f n p r = g where |
189 | V {fptr = pr} = f x | 190 | V {fptr = pr} = f x |
190 | x = createV n copy "aux_vTov" | 191 | x = createV (fromIntegral n) copy "aux_vTov" |
191 | copy n' q = do | 192 | copy n' q = do |
192 | copyArray q p n' | 193 | copyArray q p n' |
193 | return 0 | 194 | return 0 |
194 | g = withForeignPtr pr $ \p' -> copyArray r p' n | 195 | g = withForeignPtr pr $ \p' -> copyArray r p' (fromIntegral n) |
195 | 196 | ||
196 | -------------------------------------------------------------------- | 197 | -------------------------------------------------------------------- |
197 | 198 | ||