diff options
Diffstat (limited to 'packages/gsl/src/Numeric/GSL/Fitting.hs')
-rw-r--r-- | packages/gsl/src/Numeric/GSL/Fitting.hs | 16 |
1 files changed, 9 insertions, 7 deletions
diff --git a/packages/gsl/src/Numeric/GSL/Fitting.hs b/packages/gsl/src/Numeric/GSL/Fitting.hs index 0a92373..db9d82f 100644 --- a/packages/gsl/src/Numeric/GSL/Fitting.hs +++ b/packages/gsl/src/Numeric/GSL/Fitting.hs | |||
@@ -1,3 +1,5 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | ||
2 | |||
1 | {- | | 3 | {- | |
2 | Module : Numeric.GSL.Fitting | 4 | Module : Numeric.GSL.Fitting |
3 | Copyright : (c) Alberto Ruiz 2010 | 5 | Copyright : (c) Alberto Ruiz 2010 |
@@ -50,7 +52,7 @@ module Numeric.GSL.Fitting ( | |||
50 | fitModelScaled, fitModel | 52 | fitModelScaled, fitModel |
51 | ) where | 53 | ) where |
52 | 54 | ||
53 | import Numeric.LinearAlgebra | 55 | import Numeric.LinearAlgebra.HMatrix |
54 | import Numeric.GSL.Internal | 56 | import Numeric.GSL.Internal |
55 | 57 | ||
56 | import Foreign.Ptr(FunPtr, freeHaskellFunPtr) | 58 | import Foreign.Ptr(FunPtr, freeHaskellFunPtr) |
@@ -80,13 +82,13 @@ nlFitting :: FittingMethod | |||
80 | nlFitting method epsabs epsrel maxit fun jac xinit = nlFitGen (fi (fromEnum method)) fun jac xinit epsabs epsrel maxit | 82 | nlFitting method epsabs epsrel maxit fun jac xinit = nlFitGen (fi (fromEnum method)) fun jac xinit epsabs epsrel maxit |
81 | 83 | ||
82 | nlFitGen m f jac xiv epsabs epsrel maxit = unsafePerformIO $ do | 84 | nlFitGen m f jac xiv epsabs epsrel maxit = unsafePerformIO $ do |
83 | let p = dim xiv | 85 | let p = size xiv |
84 | n = dim (f xiv) | 86 | n = size (f xiv) |
85 | fp <- mkVecVecfun (aux_vTov (checkdim1 n p . f)) | 87 | fp <- mkVecVecfun (aux_vTov (checkdim1 n p . f)) |
86 | jp <- mkVecMatfun (aux_vTom (checkdim2 n p . jac)) | 88 | jp <- mkVecMatfun (aux_vTom (checkdim2 n p . jac)) |
87 | rawpath <- createMatrix RowMajor maxit (2+p) | 89 | rawpath <- createMatrix RowMajor maxit (2+p) |
88 | app2 (c_nlfit m fp jp epsabs epsrel (fi maxit) (fi n)) vec xiv mat rawpath "c_nlfit" | 90 | app2 (c_nlfit m fp jp epsabs epsrel (fi maxit) (fi n)) vec xiv mat rawpath "c_nlfit" |
89 | let it = round (rawpath @@> (maxit-1,0)) | 91 | let it = round (rawpath `atIndex` (maxit-1,0)) |
90 | path = takeRows it rawpath | 92 | path = takeRows it rawpath |
91 | [sol] = toRows $ dropRows (it-1) path | 93 | [sol] = toRows $ dropRows (it-1) path |
92 | freeHaskellFunPtr fp | 94 | freeHaskellFunPtr fp |
@@ -99,7 +101,7 @@ foreign import ccall safe "nlfit" | |||
99 | ------------------------------------------------------- | 101 | ------------------------------------------------------- |
100 | 102 | ||
101 | checkdim1 n _p v | 103 | checkdim1 n _p v |
102 | | dim v == n = v | 104 | | size v == n = v |
103 | | otherwise = error $ "Error: "++ show n | 105 | | otherwise = error $ "Error: "++ show n |
104 | ++ " components expected in the result of the function supplied to nlFitting" | 106 | ++ " components expected in the result of the function supplied to nlFitting" |
105 | 107 | ||
@@ -114,9 +116,9 @@ err (model,deriv) dat vsol = zip sol errs where | |||
114 | sol = toList vsol | 116 | sol = toList vsol |
115 | c = max 1 (chi/sqrt (fromIntegral dof)) | 117 | c = max 1 (chi/sqrt (fromIntegral dof)) |
116 | dof = length dat - (rows cov) | 118 | dof = length dat - (rows cov) |
117 | chi = norm2 (fromList $ cost (resMs model) dat sol) | 119 | chi = norm_2 (fromList $ cost (resMs model) dat sol) |
118 | js = fromLists $ jacobian (resDs deriv) dat sol | 120 | js = fromLists $ jacobian (resDs deriv) dat sol |
119 | cov = inv $ trans js <> js | 121 | cov = inv $ tr js <> js |
120 | errs = toList $ scalar c * sqrt (takeDiag cov) | 122 | errs = toList $ scalar c * sqrt (takeDiag cov) |
121 | 123 | ||
122 | 124 | ||