summaryrefslogtreecommitdiff
path: root/lib/Numeric/GSL/Minimization.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Numeric/GSL/Minimization.hs')
-rw-r--r--lib/Numeric/GSL/Minimization.hs34
1 files changed, 20 insertions, 14 deletions
diff --git a/lib/Numeric/GSL/Minimization.hs b/lib/Numeric/GSL/Minimization.hs
index f523849..e44b2e5 100644
--- a/lib/Numeric/GSL/Minimization.hs
+++ b/lib/Numeric/GSL/Minimization.hs
@@ -26,7 +26,6 @@ import Data.Packed.Matrix
26import Foreign 26import Foreign
27import Complex 27import Complex
28 28
29
30------------------------------------------------------------------------- 29-------------------------------------------------------------------------
31 30
32{- | The method of Nelder and Mead, implemented by /gsl_multimin_fminimizer_nmsimplex/. The gradient of the function is not required. This is the example in the GSL manual: 31{- | The method of Nelder and Mead, implemented by /gsl_multimin_fminimizer_nmsimplex/. The gradient of the function is not required. This is the example in the GSL manual:
@@ -85,9 +84,10 @@ minimizeNMSimplex f xi sz tol maxit = unsafePerformIO $ do
85 szv = fromList sz 84 szv = fromList sz
86 n = dim xiv 85 n = dim xiv
87 fp <- mkVecfun (iv (f.toList)) 86 fp <- mkVecfun (iv (f.toList))
88 rawpath <- createMIO maxit (n+3) 87 rawpath <- ww2 withVector xiv withVector szv $ \xiv szv ->
89 (c_minimizeNMSimplex fp tol maxit // vec xiv // vec szv) 88 createMIO maxit (n+3)
90 "minimizeNMSimplex" [xiv,szv] 89 (c_minimizeNMSimplex fp tol maxit // xiv // szv)
90 "minimizeNMSimplex"
91 let it = round (rawpath @@> (maxit-1,0)) 91 let it = round (rawpath @@> (maxit-1,0))
92 path = takeRows it rawpath 92 path = takeRows it rawpath
93 [sol] = toLists $ dropRows (it-1) path 93 [sol] = toLists $ dropRows (it-1) path
@@ -150,9 +150,10 @@ minimizeConjugateGradient istep minimpar tol maxit f df xi = unsafePerformIO $ d
150 df' = (fromList . df . toList) 150 df' = (fromList . df . toList)
151 fp <- mkVecfun (iv f') 151 fp <- mkVecfun (iv f')
152 dfp <- mkVecVecfun (aux_vTov df') 152 dfp <- mkVecVecfun (aux_vTov df')
153 rawpath <- createMIO maxit (n+2) 153 rawpath <- withVector xiv $ \xiv ->
154 (c_minimizeConjugateGradient fp dfp istep minimpar tol maxit // vec xiv) 154 createMIO maxit (n+2)
155 "minimizeDerivV" [xiv] 155 (c_minimizeConjugateGradient fp dfp istep minimpar tol maxit // xiv)
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
158 sol = toList $ cdat $ dropColumns 2 $ dropRows (it-1) path 159 sol = toList $ cdat $ dropColumns 2 $ dropRows (it-1) path
@@ -169,7 +170,7 @@ foreign import ccall "gsl-aux.h minimizeWithDeriv"
169 170
170--------------------------------------------------------------------- 171---------------------------------------------------------------------
171iv :: (Vector Double -> Double) -> (Int -> Ptr Double -> Double) 172iv :: (Vector Double -> Double) -> (Int -> Ptr Double -> Double)
172iv f n p = f (createV n copy "iv" []) where 173iv f n p = f (createV 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
@@ -187,25 +188,30 @@ foreign import ccall "wrapper"
187aux_vTov :: (Vector Double -> Vector Double) -> (Int -> Ptr Double -> Ptr Double -> IO()) 188aux_vTov :: (Vector Double -> Vector Double) -> (Int -> Ptr Double -> Ptr Double -> IO())
188aux_vTov f n p r = g where 189aux_vTov f n p r = g where
189 v@V {fptr = pr} = f x 190 v@V {fptr = pr} = f x
190 x = createV n copy "aux_vTov" [] 191 x = createV 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 $ \_ -> copyArray r (ptr v) n 195 g = withForeignPtr pr $ \p -> copyArray r p n
195 196
196-------------------------------------------------------------------- 197--------------------------------------------------------------------
197 198
198createV n fun msg ptrs = unsafePerformIO $ do 199
200createV n fun msg = unsafePerformIO $ do
199 r <- createVector n 201 r <- createVector n
200 fun // vec r // check msg ptrs 202 withVector r $ \ r ->
203 fun // r // check msg
201 return r 204 return r
202 205
206{-
203createM r c fun msg ptrs = unsafePerformIO $ do 207createM r c fun msg ptrs = unsafePerformIO $ do
204 r <- createMatrix RowMajor r c 208 r <- createMatrix RowMajor r c
205 fun // matc r // check msg ptrs 209 fun // matc r // check msg ptrs
206 return r 210 return r
211-}
207 212
208createMIO r c fun msg ptrs = do 213createMIO r c fun msg = do
209 r <- createMatrix RowMajor r c 214 r <- createMatrix RowMajor r c
210 fun // matc r // check msg ptrs 215 withMatrix r $ \ r ->
216 fun // r // check msg
211 return r 217 return r