diff options
author | Alberto Ruiz <aruiz@um.es> | 2014-05-08 08:48:12 +0200 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2014-05-08 08:48:12 +0200 |
commit | 1925c123d7d8184a1d2ddc0a413e0fd2776e1083 (patch) | |
tree | fad79f909d9c3be53d68e6ebd67202650536d387 /lib/Numeric/GSL/Root.hs | |
parent | eb3f702d065a4a967bb754977233e6eec408fd1f (diff) |
empty hmatrix-base
Diffstat (limited to 'lib/Numeric/GSL/Root.hs')
-rw-r--r-- | lib/Numeric/GSL/Root.hs | 199 |
1 files changed, 0 insertions, 199 deletions
diff --git a/lib/Numeric/GSL/Root.hs b/lib/Numeric/GSL/Root.hs deleted file mode 100644 index 9d561c4..0000000 --- a/lib/Numeric/GSL/Root.hs +++ /dev/null | |||
@@ -1,199 +0,0 @@ | |||
1 | {- | | ||
2 | Module : Numeric.GSL.Root | ||
3 | Copyright : (c) Alberto Ruiz 2009 | ||
4 | License : GPL | ||
5 | |||
6 | Maintainer : Alberto Ruiz (aruiz at um dot es) | ||
7 | Stability : provisional | ||
8 | Portability : uses ffi | ||
9 | |||
10 | Multidimensional root finding. | ||
11 | |||
12 | <http://www.gnu.org/software/gsl/manual/html_node/Multidimensional-Root_002dFinding.html> | ||
13 | |||
14 | The example in the GSL manual: | ||
15 | |||
16 | >>> let rosenbrock a b [x,y] = [ a*(1-x), b*(y-x^2) ] | ||
17 | >>> let (sol,path) = root Hybrids 1E-7 30 (rosenbrock 1 10) [-10,-5] | ||
18 | >>> sol | ||
19 | [1.0,1.0] | ||
20 | >>> disp 3 path | ||
21 | 11x5 | ||
22 | 1.000 -10.000 -5.000 11.000 -1050.000 | ||
23 | 2.000 -3.976 24.827 4.976 90.203 | ||
24 | 3.000 -3.976 24.827 4.976 90.203 | ||
25 | 4.000 -3.976 24.827 4.976 90.203 | ||
26 | 5.000 -1.274 -5.680 2.274 -73.018 | ||
27 | 6.000 -1.274 -5.680 2.274 -73.018 | ||
28 | 7.000 0.249 0.298 0.751 2.359 | ||
29 | 8.000 0.249 0.298 0.751 2.359 | ||
30 | 9.000 1.000 0.878 -0.000 -1.218 | ||
31 | 10.000 1.000 0.989 -0.000 -0.108 | ||
32 | 11.000 1.000 1.000 0.000 0.000 | ||
33 | |||
34 | -} | ||
35 | ----------------------------------------------------------------------------- | ||
36 | |||
37 | module Numeric.GSL.Root ( | ||
38 | uniRoot, UniRootMethod(..), | ||
39 | uniRootJ, UniRootMethodJ(..), | ||
40 | root, RootMethod(..), | ||
41 | rootJ, RootMethodJ(..), | ||
42 | ) where | ||
43 | |||
44 | import Data.Packed.Internal | ||
45 | import Data.Packed.Matrix | ||
46 | import Numeric.GSL.Internal | ||
47 | import Foreign.Ptr(FunPtr, freeHaskellFunPtr) | ||
48 | import Foreign.C.Types | ||
49 | import System.IO.Unsafe(unsafePerformIO) | ||
50 | |||
51 | ------------------------------------------------------------------------- | ||
52 | |||
53 | data UniRootMethod = Bisection | ||
54 | | FalsePos | ||
55 | | Brent | ||
56 | deriving (Enum, Eq, Show, Bounded) | ||
57 | |||
58 | uniRoot :: UniRootMethod | ||
59 | -> Double | ||
60 | -> Int | ||
61 | -> (Double -> Double) | ||
62 | -> Double | ||
63 | -> Double | ||
64 | -> (Double, Matrix Double) | ||
65 | uniRoot method epsrel maxit fun xl xu = uniRootGen (fi (fromEnum method)) fun xl xu epsrel maxit | ||
66 | |||
67 | uniRootGen m f xl xu epsrel maxit = unsafePerformIO $ do | ||
68 | fp <- mkDoublefun f | ||
69 | rawpath <- createMIO maxit 4 | ||
70 | (c_root m fp epsrel (fi maxit) xl xu) | ||
71 | "root" | ||
72 | let it = round (rawpath @@> (maxit-1,0)) | ||
73 | path = takeRows it rawpath | ||
74 | [sol] = toLists $ dropRows (it-1) path | ||
75 | freeHaskellFunPtr fp | ||
76 | return (sol !! 1, path) | ||
77 | |||
78 | foreign import ccall safe "root" | ||
79 | c_root:: CInt -> FunPtr (Double -> Double) -> Double -> CInt -> Double -> Double -> TM | ||
80 | |||
81 | ------------------------------------------------------------------------- | ||
82 | data UniRootMethodJ = UNewton | ||
83 | | Secant | ||
84 | | Steffenson | ||
85 | deriving (Enum, Eq, Show, Bounded) | ||
86 | |||
87 | uniRootJ :: UniRootMethodJ | ||
88 | -> Double | ||
89 | -> Int | ||
90 | -> (Double -> Double) | ||
91 | -> (Double -> Double) | ||
92 | -> Double | ||
93 | -> (Double, Matrix Double) | ||
94 | uniRootJ method epsrel maxit fun dfun x = uniRootJGen (fi (fromEnum method)) fun | ||
95 | dfun x epsrel maxit | ||
96 | |||
97 | uniRootJGen m f df x epsrel maxit = unsafePerformIO $ do | ||
98 | fp <- mkDoublefun f | ||
99 | dfp <- mkDoublefun df | ||
100 | rawpath <- createMIO maxit 2 | ||
101 | (c_rootj m fp dfp epsrel (fi maxit) x) | ||
102 | "rootj" | ||
103 | let it = round (rawpath @@> (maxit-1,0)) | ||
104 | path = takeRows it rawpath | ||
105 | [sol] = toLists $ dropRows (it-1) path | ||
106 | freeHaskellFunPtr fp | ||
107 | return (sol !! 1, path) | ||
108 | |||
109 | foreign import ccall safe "rootj" | ||
110 | c_rootj :: CInt -> FunPtr (Double -> Double) -> FunPtr (Double -> Double) | ||
111 | -> Double -> CInt -> Double -> TM | ||
112 | |||
113 | ------------------------------------------------------------------------- | ||
114 | |||
115 | data RootMethod = Hybrids | ||
116 | | Hybrid | ||
117 | | DNewton | ||
118 | | Broyden | ||
119 | deriving (Enum,Eq,Show,Bounded) | ||
120 | |||
121 | -- | Nonlinear multidimensional root finding using algorithms that do not require | ||
122 | -- any derivative information to be supplied by the user. | ||
123 | -- Any derivatives needed are approximated by finite differences. | ||
124 | root :: RootMethod | ||
125 | -> Double -- ^ maximum residual | ||
126 | -> Int -- ^ maximum number of iterations allowed | ||
127 | -> ([Double] -> [Double]) -- ^ function to minimize | ||
128 | -> [Double] -- ^ starting point | ||
129 | -> ([Double], Matrix Double) -- ^ solution vector and optimization path | ||
130 | |||
131 | root method epsabs maxit fun xinit = rootGen (fi (fromEnum method)) fun xinit epsabs maxit | ||
132 | |||
133 | rootGen m f xi epsabs maxit = unsafePerformIO $ do | ||
134 | let xiv = fromList xi | ||
135 | n = dim xiv | ||
136 | fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList)) | ||
137 | rawpath <- vec xiv $ \xiv' -> | ||
138 | createMIO maxit (2*n+1) | ||
139 | (c_multiroot m fp epsabs (fi maxit) // xiv') | ||
140 | "multiroot" | ||
141 | let it = round (rawpath @@> (maxit-1,0)) | ||
142 | path = takeRows it rawpath | ||
143 | [sol] = toLists $ dropRows (it-1) path | ||
144 | freeHaskellFunPtr fp | ||
145 | return (take n $ drop 1 sol, path) | ||
146 | |||
147 | |||
148 | foreign import ccall safe "multiroot" | ||
149 | c_multiroot:: CInt -> FunPtr TVV -> Double -> CInt -> TVM | ||
150 | |||
151 | ------------------------------------------------------------------------- | ||
152 | |||
153 | data RootMethodJ = HybridsJ | ||
154 | | HybridJ | ||
155 | | Newton | ||
156 | | GNewton | ||
157 | deriving (Enum,Eq,Show,Bounded) | ||
158 | |||
159 | -- | Nonlinear multidimensional root finding using both the function and its derivatives. | ||
160 | rootJ :: RootMethodJ | ||
161 | -> Double -- ^ maximum residual | ||
162 | -> Int -- ^ maximum number of iterations allowed | ||
163 | -> ([Double] -> [Double]) -- ^ function to minimize | ||
164 | -> ([Double] -> [[Double]]) -- ^ Jacobian | ||
165 | -> [Double] -- ^ starting point | ||
166 | -> ([Double], Matrix Double) -- ^ solution vector and optimization path | ||
167 | |||
168 | rootJ method epsabs maxit fun jac xinit = rootJGen (fi (fromEnum method)) fun jac xinit epsabs maxit | ||
169 | |||
170 | rootJGen m f jac xi epsabs maxit = unsafePerformIO $ do | ||
171 | let xiv = fromList xi | ||
172 | n = dim xiv | ||
173 | fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList)) | ||
174 | jp <- mkVecMatfun (aux_vTom (checkdim2 n . fromLists . jac . toList)) | ||
175 | rawpath <- vec xiv $ \xiv' -> | ||
176 | createMIO maxit (2*n+1) | ||
177 | (c_multirootj m fp jp epsabs (fi maxit) // xiv') | ||
178 | "multiroot" | ||
179 | let it = round (rawpath @@> (maxit-1,0)) | ||
180 | path = takeRows it rawpath | ||
181 | [sol] = toLists $ dropRows (it-1) path | ||
182 | freeHaskellFunPtr fp | ||
183 | freeHaskellFunPtr jp | ||
184 | return (take n $ drop 1 sol, path) | ||
185 | |||
186 | foreign import ccall safe "multirootj" | ||
187 | c_multirootj:: CInt -> FunPtr TVV -> FunPtr TVM -> Double -> CInt -> TVM | ||
188 | |||
189 | ------------------------------------------------------- | ||
190 | |||
191 | checkdim1 n v | ||
192 | | dim v == n = v | ||
193 | | otherwise = error $ "Error: "++ show n | ||
194 | ++ " components expected in the result of the function supplied to root" | ||
195 | |||
196 | checkdim2 n m | ||
197 | | rows m == n && cols m == n = m | ||
198 | | otherwise = error $ "Error: "++ show n ++ "x" ++ show n | ||
199 | ++ " Jacobian expected in rootJ" | ||