summaryrefslogtreecommitdiff
path: root/packages/gsl/src/Numeric/GSL/Root.hs
diff options
context:
space:
mode:
Diffstat (limited to 'packages/gsl/src/Numeric/GSL/Root.hs')
-rw-r--r--packages/gsl/src/Numeric/GSL/Root.hs18
1 files changed, 10 insertions, 8 deletions
diff --git a/packages/gsl/src/Numeric/GSL/Root.hs b/packages/gsl/src/Numeric/GSL/Root.hs
index b9f3b94..724f32f 100644
--- a/packages/gsl/src/Numeric/GSL/Root.hs
+++ b/packages/gsl/src/Numeric/GSL/Root.hs
@@ -1,3 +1,5 @@
1{-# LANGUAGE FlexibleContexts #-}
2
1{- | 3{- |
2Module : Numeric.GSL.Root 4Module : Numeric.GSL.Root
3Copyright : (c) Alberto Ruiz 2009 5Copyright : (c) Alberto Ruiz 2009
@@ -39,7 +41,7 @@ module Numeric.GSL.Root (
39 rootJ, RootMethodJ(..), 41 rootJ, RootMethodJ(..),
40) where 42) where
41 43
42import Data.Packed 44import Numeric.LinearAlgebra.HMatrix
43import Numeric.GSL.Internal 45import Numeric.GSL.Internal
44import Foreign.Ptr(FunPtr, freeHaskellFunPtr) 46import Foreign.Ptr(FunPtr, freeHaskellFunPtr)
45import Foreign.C.Types 47import Foreign.C.Types
@@ -69,7 +71,7 @@ uniRootGen m f xl xu epsrel maxit = unsafePerformIO $ do
69 rawpath <- createMIO maxit 4 71 rawpath <- createMIO maxit 4
70 (c_root m fp epsrel (fi maxit) xl xu) 72 (c_root m fp epsrel (fi maxit) xl xu)
71 "root" 73 "root"
72 let it = round (rawpath @@> (maxit-1,0)) 74 let it = round (rawpath `atIndex` (maxit-1,0))
73 path = takeRows it rawpath 75 path = takeRows it rawpath
74 [sol] = toLists $ dropRows (it-1) path 76 [sol] = toLists $ dropRows (it-1) path
75 freeHaskellFunPtr fp 77 freeHaskellFunPtr fp
@@ -100,7 +102,7 @@ uniRootJGen m f df x epsrel maxit = unsafePerformIO $ do
100 rawpath <- createMIO maxit 2 102 rawpath <- createMIO maxit 2
101 (c_rootj m fp dfp epsrel (fi maxit) x) 103 (c_rootj m fp dfp epsrel (fi maxit) x)
102 "rootj" 104 "rootj"
103 let it = round (rawpath @@> (maxit-1,0)) 105 let it = round (rawpath `atIndex` (maxit-1,0))
104 path = takeRows it rawpath 106 path = takeRows it rawpath
105 [sol] = toLists $ dropRows (it-1) path 107 [sol] = toLists $ dropRows (it-1) path
106 freeHaskellFunPtr fp 108 freeHaskellFunPtr fp
@@ -132,13 +134,13 @@ root method epsabs maxit fun xinit = rootGen (fi (fromEnum method)) fun xinit ep
132 134
133rootGen m f xi epsabs maxit = unsafePerformIO $ do 135rootGen m f xi epsabs maxit = unsafePerformIO $ do
134 let xiv = fromList xi 136 let xiv = fromList xi
135 n = dim xiv 137 n = size xiv
136 fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList)) 138 fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList))
137 rawpath <- vec xiv $ \xiv' -> 139 rawpath <- vec xiv $ \xiv' ->
138 createMIO maxit (2*n+1) 140 createMIO maxit (2*n+1)
139 (c_multiroot m fp epsabs (fi maxit) // xiv') 141 (c_multiroot m fp epsabs (fi maxit) // xiv')
140 "multiroot" 142 "multiroot"
141 let it = round (rawpath @@> (maxit-1,0)) 143 let it = round (rawpath `atIndex` (maxit-1,0))
142 path = takeRows it rawpath 144 path = takeRows it rawpath
143 [sol] = toLists $ dropRows (it-1) path 145 [sol] = toLists $ dropRows (it-1) path
144 freeHaskellFunPtr fp 146 freeHaskellFunPtr fp
@@ -169,14 +171,14 @@ rootJ method epsabs maxit fun jac xinit = rootJGen (fi (fromEnum method)) fun ja
169 171
170rootJGen m f jac xi epsabs maxit = unsafePerformIO $ do 172rootJGen m f jac xi epsabs maxit = unsafePerformIO $ do
171 let xiv = fromList xi 173 let xiv = fromList xi
172 n = dim xiv 174 n = size xiv
173 fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList)) 175 fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList))
174 jp <- mkVecMatfun (aux_vTom (checkdim2 n . fromLists . jac . toList)) 176 jp <- mkVecMatfun (aux_vTom (checkdim2 n . fromLists . jac . toList))
175 rawpath <- vec xiv $ \xiv' -> 177 rawpath <- vec xiv $ \xiv' ->
176 createMIO maxit (2*n+1) 178 createMIO maxit (2*n+1)
177 (c_multirootj m fp jp epsabs (fi maxit) // xiv') 179 (c_multirootj m fp jp epsabs (fi maxit) // xiv')
178 "multiroot" 180 "multiroot"
179 let it = round (rawpath @@> (maxit-1,0)) 181 let it = round (rawpath `atIndex` (maxit-1,0))
180 path = takeRows it rawpath 182 path = takeRows it rawpath
181 [sol] = toLists $ dropRows (it-1) path 183 [sol] = toLists $ dropRows (it-1) path
182 freeHaskellFunPtr fp 184 freeHaskellFunPtr fp
@@ -189,7 +191,7 @@ foreign import ccall safe "multirootj"
189------------------------------------------------------- 191-------------------------------------------------------
190 192
191checkdim1 n v 193checkdim1 n v
192 | dim v == n = v 194 | size v == n = v
193 | otherwise = error $ "Error: "++ show n 195 | otherwise = error $ "Error: "++ show n
194 ++ " components expected in the result of the function supplied to root" 196 ++ " components expected in the result of the function supplied to root"
195 197