diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Data/Packed/Internal/Common.hs | 3 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/Matrix.hs | 19 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/Vector.hs | 7 | ||||
-rw-r--r-- | lib/Data/Packed/Matrix.hs | 22 | ||||
-rw-r--r-- | lib/Data/Packed/Vector.hs | 1 | ||||
-rw-r--r-- | lib/Graphics/Plot.hs | 8 | ||||
-rw-r--r-- | lib/Numeric/GSL/Differentiation.hs | 2 | ||||
-rw-r--r-- | lib/Numeric/GSL/Matrix.hs | 24 | ||||
-rw-r--r-- | lib/Numeric/GSL/Minimization.hs | 27 | ||||
-rw-r--r-- | lib/Numeric/GSL/Special.hs | 2 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra.hs | 2 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/Algorithms.hs | 29 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/LAPACK.hs | 3 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/Linear.hs | 2 |
14 files changed, 71 insertions, 80 deletions
diff --git a/lib/Data/Packed/Internal/Common.hs b/lib/Data/Packed/Internal/Common.hs index dc1c2b4..7305d8c 100644 --- a/lib/Data/Packed/Internal/Common.hs +++ b/lib/Data/Packed/Internal/Common.hs | |||
@@ -20,9 +20,6 @@ import Foreign | |||
20 | import Complex | 20 | import Complex |
21 | import Control.Monad(when) | 21 | import Control.Monad(when) |
22 | import Debug.Trace | 22 | import Debug.Trace |
23 | import Data.List(transpose,intersperse) | ||
24 | import Data.Typeable | ||
25 | import Data.Maybe(fromJust) | ||
26 | import Foreign.C.String(peekCString) | 23 | import Foreign.C.String(peekCString) |
27 | import Foreign.C.Types | 24 | import Foreign.C.Types |
28 | 25 | ||
diff --git a/lib/Data/Packed/Internal/Matrix.hs b/lib/Data/Packed/Internal/Matrix.hs index 0519603..4cc94b7 100644 --- a/lib/Data/Packed/Internal/Matrix.hs +++ b/lib/Data/Packed/Internal/Matrix.hs | |||
@@ -22,7 +22,6 @@ import Data.Packed.Internal.Vector | |||
22 | import Foreign hiding (xor) | 22 | import Foreign hiding (xor) |
23 | import Complex | 23 | import Complex |
24 | import Control.Monad(when) | 24 | import Control.Monad(when) |
25 | import Data.Maybe(fromJust) | ||
26 | import Foreign.C.String | 25 | import Foreign.C.String |
27 | import Foreign.C.Types | 26 | import Foreign.C.Types |
28 | import Data.List(transpose) | 27 | import Data.List(transpose) |
@@ -83,14 +82,14 @@ mat = withMatrix | |||
83 | 82 | ||
84 | withMatrix MC {rows = r, cols = c, cdat = d } f = | 83 | withMatrix MC {rows = r, cols = c, cdat = d } f = |
85 | withForeignPtr (fptr d) $ \p -> do | 84 | withForeignPtr (fptr d) $ \p -> do |
86 | let m f = do | 85 | let m g = do |
87 | f r c p | 86 | g r c p |
88 | f m | 87 | f m |
89 | 88 | ||
90 | withMatrix MF {rows = r, cols = c, fdat = d } f = | 89 | withMatrix MF {rows = r, cols = c, fdat = d } f = |
91 | withForeignPtr (fptr d) $ \p -> do | 90 | withForeignPtr (fptr d) $ \p -> do |
92 | let m f = do | 91 | let m g = do |
93 | f r c p | 92 | g r c p |
94 | f m | 93 | f m |
95 | 94 | ||
96 | {- | Creates a vector by concatenation of rows | 95 | {- | Creates a vector by concatenation of rows |
@@ -262,8 +261,8 @@ foreign import ccall safe "auxi.h transC" | |||
262 | 261 | ||
263 | ------------------------------------------------------------------ | 262 | ------------------------------------------------------------------ |
264 | 263 | ||
265 | gmatC MF {rows = r, cols = c, fdat = d} p f = f 1 c r p | 264 | gmatC MF { rows = r, cols = c } p f = f 1 c r p |
266 | gmatC MC {rows = r, cols = c, cdat = d} p f = f 0 r c p | 265 | gmatC MC { rows = r, cols = c } p f = f 0 r c p |
267 | 266 | ||
268 | dtt MC { cdat = d } = d | 267 | dtt MC { cdat = d } = d |
269 | dtt MF { fdat = d } = d | 268 | dtt MF { fdat = d } = d |
@@ -273,8 +272,8 @@ multiplyAux fun a b = unsafePerformIO $ do | |||
273 | show (rows a,cols a) ++ " x " ++ show (rows b, cols b) | 272 | show (rows a,cols a) ++ " x " ++ show (rows b, cols b) |
274 | r <- createMatrix RowMajor (rows a) (cols b) | 273 | r <- createMatrix RowMajor (rows a) (cols b) |
275 | withForeignPtr (fptr (dtt a)) $ \pa -> withForeignPtr (fptr (dtt b)) $ \pb -> | 274 | withForeignPtr (fptr (dtt a)) $ \pa -> withForeignPtr (fptr (dtt b)) $ \pb -> |
276 | withMatrix r $ \r -> | 275 | withMatrix r $ \r' -> |
277 | fun // gmatC a pa // gmatC b pb // r // check "multiplyAux" | 276 | fun // gmatC a pa // gmatC b pb // r' // check "multiplyAux" |
278 | return r | 277 | return r |
279 | 278 | ||
280 | multiplyR = multiplyAux cmultiplyR | 279 | multiplyR = multiplyAux cmultiplyR |
@@ -421,7 +420,7 @@ diagG v = matrixFromVector RowMajor c $ fromList $ [ l!!(i-1) * delta k i | k <- | |||
421 | | otherwise = 0 | 420 | | otherwise = 0 |
422 | -} | 421 | -} |
423 | 422 | ||
424 | transdataG c1 d c2 = fromList . concat . transpose . partit c1 . toList $ d | 423 | transdataG c1 d _ = fromList . concat . transpose . partit c1 . toList $ d |
425 | 424 | ||
426 | dotL a b = sum (zipWith (*) a b) | 425 | dotL a b = sum (zipWith (*) a b) |
427 | 426 | ||
diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs index 7eee5fe..ac6588b 100644 --- a/lib/Data/Packed/Internal/Vector.hs +++ b/lib/Data/Packed/Internal/Vector.hs | |||
@@ -20,7 +20,6 @@ import Data.Packed.Internal.Common | |||
20 | import Foreign | 20 | import Foreign |
21 | import Complex | 21 | import Complex |
22 | import Control.Monad(when) | 22 | import Control.Monad(when) |
23 | import Data.List(transpose) | ||
24 | 23 | ||
25 | -- | A one-dimensional array of objects stored in a contiguous memory block. | 24 | -- | A one-dimensional array of objects stored in a contiguous memory block. |
26 | data Vector t = V { dim :: Int -- ^ number of elements | 25 | data Vector t = V { dim :: Int -- ^ number of elements |
@@ -39,8 +38,8 @@ type Vc t s = Int -> Ptr t -> s | |||
39 | vec = withVector | 38 | vec = withVector |
40 | 39 | ||
41 | withVector (V n fp) f = withForeignPtr fp $ \p -> do | 40 | withVector (V n fp) f = withForeignPtr fp $ \p -> do |
42 | let v f = do | 41 | let v g = do |
43 | f n p | 42 | g n p |
44 | f v | 43 | f v |
45 | 44 | ||
46 | -- | allocates memory for a new vector | 45 | -- | allocates memory for a new vector |
@@ -132,7 +131,7 @@ join as = unsafePerformIO $ do | |||
132 | joiner as tot ptr | 131 | joiner as tot ptr |
133 | return r | 132 | return r |
134 | where joiner [] _ _ = return () | 133 | where joiner [] _ _ = return () |
135 | joiner (r@V {dim = n, fptr = b} : cs) _ p = do | 134 | joiner (V {dim = n, fptr = b} : cs) _ p = do |
136 | withForeignPtr b $ \pb -> copyArray p pb n | 135 | withForeignPtr b $ \pb -> copyArray p pb n |
137 | joiner cs 0 (advancePtr p n) | 136 | joiner cs 0 (advancePtr p n) |
138 | 137 | ||
diff --git a/lib/Data/Packed/Matrix.hs b/lib/Data/Packed/Matrix.hs index 7b6bf29..62d28b1 100644 --- a/lib/Data/Packed/Matrix.hs +++ b/lib/Data/Packed/Matrix.hs | |||
@@ -33,10 +33,7 @@ module Data.Packed.Matrix ( | |||
33 | ) where | 33 | ) where |
34 | 34 | ||
35 | import Data.Packed.Internal | 35 | import Data.Packed.Internal |
36 | import Foreign(Storable) | ||
37 | import Complex | ||
38 | import Data.Packed.Vector | 36 | import Data.Packed.Vector |
39 | import Numeric(showGFloat) | ||
40 | import Data.List(transpose,intersperse) | 37 | import Data.List(transpose,intersperse) |
41 | import Data.Array | 38 | import Data.Array |
42 | 39 | ||
@@ -89,8 +86,8 @@ diagRect s r c | |||
89 | | dim s < min r c = error "diagRect" | 86 | | dim s < min r c = error "diagRect" |
90 | | r == c = diag s | 87 | | r == c = diag s |
91 | | r < c = trans $ diagRect s c r | 88 | | r < c = trans $ diagRect s c r |
92 | | r > c = joinVert [diag s , zeros (r-c,c)] | 89 | | otherwise = joinVert [diag s , zeros (r-c,c)] |
93 | where zeros (r,c) = reshape c $ constantD 0 (r*c) | 90 | where zeros (r',c') = reshape c' $ constantD 0 (r'*c') |
94 | 91 | ||
95 | -- | extracts the diagonal from a rectangular matrix | 92 | -- | extracts the diagonal from a rectangular matrix |
96 | takeDiag :: (Element t) => Matrix t -> Vector t | 93 | takeDiag :: (Element t) => Matrix t -> Vector t |
@@ -123,16 +120,16 @@ r >< c = f where | |||
123 | 120 | ||
124 | -- | Creates a matrix with the first n rows of another matrix | 121 | -- | Creates a matrix with the first n rows of another matrix |
125 | takeRows :: Element t => Int -> Matrix t -> Matrix t | 122 | takeRows :: Element t => Int -> Matrix t -> Matrix t |
126 | takeRows n mat = subMatrix (0,0) (n, cols mat) mat | 123 | takeRows n mt = subMatrix (0,0) (n, cols mt) mt |
127 | -- | Creates a copy of a matrix without the first n rows | 124 | -- | Creates a copy of a matrix without the first n rows |
128 | dropRows :: Element t => Int -> Matrix t -> Matrix t | 125 | dropRows :: Element t => Int -> Matrix t -> Matrix t |
129 | dropRows n mat = subMatrix (n,0) (rows mat - n, cols mat) mat | 126 | dropRows n mt = subMatrix (n,0) (rows mt - n, cols mt) mt |
130 | -- |Creates a matrix with the first n columns of another matrix | 127 | -- |Creates a matrix with the first n columns of another matrix |
131 | takeColumns :: Element t => Int -> Matrix t -> Matrix t | 128 | takeColumns :: Element t => Int -> Matrix t -> Matrix t |
132 | takeColumns n mat = subMatrix (0,0) (rows mat, n) mat | 129 | takeColumns n mt = subMatrix (0,0) (rows mt, n) mt |
133 | -- | Creates a copy of a matrix without the first n columns | 130 | -- | Creates a copy of a matrix without the first n columns |
134 | dropColumns :: Element t => Int -> Matrix t -> Matrix t | 131 | dropColumns :: Element t => Int -> Matrix t -> Matrix t |
135 | dropColumns n mat = subMatrix (0,n) (rows mat, cols mat - n) mat | 132 | dropColumns n mt = subMatrix (0,n) (rows mt, cols mt - n) mt |
136 | 133 | ||
137 | ---------------------------------------------------------------- | 134 | ---------------------------------------------------------------- |
138 | 135 | ||
@@ -164,6 +161,7 @@ fromArray2D m = (r><c) (elems m) | |||
164 | c = c1-c0+1 | 161 | c = c1-c0+1 |
165 | 162 | ||
166 | ------------------------------------------------------ | 163 | ------------------------------------------------------ |
164 | {- | ||
167 | -- shows a Double with n digits after the decimal point | 165 | -- shows a Double with n digits after the decimal point |
168 | shf :: (RealFloat a) => Int -> a -> String | 166 | shf :: (RealFloat a) => Int -> a -> String |
169 | shf dec n | abs n < 1e-10 = "0." | 167 | shf dec n | abs n < 1e-10 = "0." |
@@ -177,6 +175,8 @@ shfc n z@ (a:+b) | |||
177 | | b > 0 = shf n a ++"+"++shf n b ++"i" | 175 | | b > 0 = shf n a ++"+"++shf n b ++"i" |
178 | | otherwise = shf n a ++shf n b ++"i" | 176 | | otherwise = shf n a ++shf n b ++"i" |
179 | 177 | ||
178 | -} | ||
179 | |||
180 | dsp' :: String -> [[String]] -> String | 180 | dsp' :: String -> [[String]] -> String |
181 | dsp' sep as = unlines . map unwords' $ transpose mtp where | 181 | dsp' sep as = unlines . map unwords' $ transpose mtp where |
182 | mt = transpose as | 182 | mt = transpose as |
@@ -196,6 +196,7 @@ this function the user can easily define any desired display function: | |||
196 | format :: (Element t) => String -> (t -> String) -> Matrix t -> String | 196 | format :: (Element t) => String -> (t -> String) -> Matrix t -> String |
197 | format sep f m = dsp' sep . map (map f) . toLists $ m | 197 | format sep f m = dsp' sep . map (map f) . toLists $ m |
198 | 198 | ||
199 | {- | ||
199 | disp m f = putStrLn $ "matrix ("++show (rows m) ++"x"++ show (cols m) ++")\n"++format " | " f m | 200 | disp m f = putStrLn $ "matrix ("++show (rows m) ++"x"++ show (cols m) ++")\n"++format " | " f m |
200 | 201 | ||
201 | dispR :: Int -> Matrix Double -> IO () | 202 | dispR :: Int -> Matrix Double -> IO () |
@@ -203,6 +204,7 @@ dispR d m = disp m (shf d) | |||
203 | 204 | ||
204 | dispC :: Int -> Matrix (Complex Double) -> IO () | 205 | dispC :: Int -> Matrix (Complex Double) -> IO () |
205 | dispC d m = disp m (shfc d) | 206 | dispC d m = disp m (shfc d) |
207 | -} | ||
206 | 208 | ||
207 | -- | creates a matrix from a table of numbers. | 209 | -- | creates a matrix from a table of numbers. |
208 | readMatrix :: String -> Matrix Double | 210 | readMatrix :: String -> Matrix Double |
@@ -211,7 +213,7 @@ readMatrix = fromLists . map (map read). map words . filter (not.null) . lines | |||
211 | -- | rearranges the rows of a matrix according to the order given in a list of integers. | 213 | -- | rearranges the rows of a matrix according to the order given in a list of integers. |
212 | extractRows :: Element t => [Int] -> Matrix t -> Matrix t | 214 | extractRows :: Element t => [Int] -> Matrix t -> Matrix t |
213 | extractRows l m = fromRows $ extract (toRows $ m) l | 215 | extractRows l m = fromRows $ extract (toRows $ m) l |
214 | where extract l is = [l!!i |i<-is] | 216 | where extract l' is = [l'!!i |i<-is] |
215 | 217 | ||
216 | {- | creates matrix by repetition of a matrix a given number of rows and columns | 218 | {- | creates matrix by repetition of a matrix a given number of rows and columns |
217 | 219 | ||
diff --git a/lib/Data/Packed/Vector.hs b/lib/Data/Packed/Vector.hs index 60fa7c1..6415c5c 100644 --- a/lib/Data/Packed/Vector.hs +++ b/lib/Data/Packed/Vector.hs | |||
@@ -23,7 +23,6 @@ module Data.Packed.Vector ( | |||
23 | ) where | 23 | ) where |
24 | 24 | ||
25 | import Data.Packed.Internal | 25 | import Data.Packed.Internal |
26 | import Complex | ||
27 | import Numeric.GSL.Vector | 26 | import Numeric.GSL.Vector |
28 | 27 | ||
29 | {- | Creates a real vector containing a range of values: | 28 | {- | Creates a real vector containing a range of values: |
diff --git a/lib/Graphics/Plot.hs b/lib/Graphics/Plot.hs index c763294..d2c96a6 100644 --- a/lib/Graphics/Plot.hs +++ b/lib/Graphics/Plot.hs | |||
@@ -32,8 +32,6 @@ import Numeric.LinearAlgebra.Linear(outer) | |||
32 | import Numeric.GSL.Vector(FunCodeS(Max,Min),toScalarR) | 32 | import Numeric.GSL.Vector(FunCodeS(Max,Min),toScalarR) |
33 | import Data.List(intersperse) | 33 | import Data.List(intersperse) |
34 | import System | 34 | import System |
35 | import Data.IORef | ||
36 | import System.Exit | ||
37 | import Foreign hiding (rotate) | 35 | import Foreign hiding (rotate) |
38 | 36 | ||
39 | 37 | ||
@@ -107,10 +105,7 @@ mplot m = gnuplotX (commands++dats) where | |||
107 | dats = concat (replicate (length m-1) dat) | 105 | dats = concat (replicate (length m-1) dat) |
108 | 106 | ||
109 | 107 | ||
110 | 108 | {- | |
111 | |||
112 | |||
113 | |||
114 | mplot' m = do | 109 | mplot' m = do |
115 | writeFile "plot-gnu-command" (commands++endcmd) | 110 | writeFile "plot-gnu-command" (commands++endcmd) |
116 | toFile "plot-tmp.txt" (fromColumns m) | 111 | toFile "plot-tmp.txt" (fromColumns m) |
@@ -125,6 +120,7 @@ mplot' m = do | |||
125 | plots = concat $ intersperse ", " (map cmd [2 .. length m]) | 120 | plots = concat $ intersperse ", " (map cmd [2 .. length m]) |
126 | cmd k = "\"plot-tmp.txt\" using 1:"++show k++" with lines" | 121 | cmd k = "\"plot-tmp.txt\" using 1:"++show k++" with lines" |
127 | endcmd = "pause -1" | 122 | endcmd = "pause -1" |
123 | -} | ||
128 | 124 | ||
129 | -- apply several functions to one object | 125 | -- apply several functions to one object |
130 | mapf fs x = map ($ x) fs | 126 | mapf fs x = map ($ x) fs |
diff --git a/lib/Numeric/GSL/Differentiation.hs b/lib/Numeric/GSL/Differentiation.hs index 09236bd..071704a 100644 --- a/lib/Numeric/GSL/Differentiation.hs +++ b/lib/Numeric/GSL/Differentiation.hs | |||
@@ -34,7 +34,7 @@ derivGen :: | |||
34 | derivGen c h f x = unsafePerformIO $ do | 34 | derivGen c h f x = unsafePerformIO $ do |
35 | r <- malloc | 35 | r <- malloc |
36 | e <- malloc | 36 | e <- malloc |
37 | fp <- mkfun (\x _ -> f x) | 37 | fp <- mkfun (\y _ -> f y) |
38 | c_deriv c fp x h r e // check "deriv" | 38 | c_deriv c fp x h r e // check "deriv" |
39 | vr <- peek r | 39 | vr <- peek r |
40 | ve <- peek e | 40 | ve <- peek e |
diff --git a/lib/Numeric/GSL/Matrix.hs b/lib/Numeric/GSL/Matrix.hs index 07d4660..d51728e 100644 --- a/lib/Numeric/GSL/Matrix.hs +++ b/lib/Numeric/GSL/Matrix.hs | |||
@@ -17,13 +17,13 @@ module Numeric.GSL.Matrix( | |||
17 | eigSg, eigHg, | 17 | eigSg, eigHg, |
18 | svdg, | 18 | svdg, |
19 | qr, qrPacked, unpackQR, | 19 | qr, qrPacked, unpackQR, |
20 | cholR, -- cholC, | 20 | cholR, cholC, |
21 | luSolveR, luSolveC, | 21 | luSolveR, luSolveC, |
22 | luR, luC | 22 | luR, luC |
23 | ) where | 23 | ) where |
24 | 24 | ||
25 | import Data.Packed.Internal | 25 | import Data.Packed.Internal |
26 | import Data.Packed.Matrix(fromLists,ident,takeDiag) | 26 | import Data.Packed.Matrix(ident) |
27 | import Numeric.GSL.Vector | 27 | import Numeric.GSL.Vector |
28 | import Foreign | 28 | import Foreign |
29 | import Complex | 29 | import Complex |
@@ -44,7 +44,7 @@ import Complex | |||
44 | 44 | ||
45 | -} | 45 | -} |
46 | eigSg :: Matrix Double -> (Vector Double, Matrix Double) | 46 | eigSg :: Matrix Double -> (Vector Double, Matrix Double) |
47 | eigSg = eigSg . cmat | 47 | eigSg = eigSg' . cmat |
48 | 48 | ||
49 | eigSg' m | 49 | eigSg' m |
50 | | r == 1 = (fromList [cdat m `at` 0], singleton 1) | 50 | | r == 1 = (fromList [cdat m `at` 0], singleton 1) |
@@ -159,24 +159,24 @@ qrPacked :: Matrix Double -> (Matrix Double, Vector Double) | |||
159 | qrPacked = qrPacked' . cmat | 159 | qrPacked = qrPacked' . cmat |
160 | 160 | ||
161 | qrPacked' x = unsafePerformIO $ do | 161 | qrPacked' x = unsafePerformIO $ do |
162 | qr <- createMatrix RowMajor r c | 162 | qrp <- createMatrix RowMajor r c |
163 | tau <- createVector (min r c) | 163 | tau <- createVector (min r c) |
164 | app3 c_qrPacked mat x mat qr vec tau "qrUnpacked" | 164 | app3 c_qrPacked mat x mat qrp vec tau "qrUnpacked" |
165 | return (qr,tau) | 165 | return (qrp,tau) |
166 | where r = rows x | 166 | where r = rows x |
167 | c = cols x | 167 | c = cols x |
168 | foreign import ccall "gsl-aux.h QRpacked" c_qrPacked :: TMMV | 168 | foreign import ccall "gsl-aux.h QRpacked" c_qrPacked :: TMMV |
169 | 169 | ||
170 | unpackQR :: (Matrix Double, Vector Double) -> (Matrix Double, Matrix Double) | 170 | unpackQR :: (Matrix Double, Vector Double) -> (Matrix Double, Matrix Double) |
171 | unpackQR (qr,tau) = unpackQR' (cmat qr, tau) | 171 | unpackQR (qrp,tau) = unpackQR' (cmat qrp, tau) |
172 | 172 | ||
173 | unpackQR' (qr,tau) = unsafePerformIO $ do | 173 | unpackQR' (qrp,tau) = unsafePerformIO $ do |
174 | q <- createMatrix RowMajor r r | 174 | q <- createMatrix RowMajor r r |
175 | res <- createMatrix RowMajor r c | 175 | res <- createMatrix RowMajor r c |
176 | app4 c_qrUnpack mat qr vec tau mat q mat res "qrUnpack" | 176 | app4 c_qrUnpack mat qrp vec tau mat q mat res "qrUnpack" |
177 | return (q,res) | 177 | return (q,res) |
178 | where r = rows qr | 178 | where r = rows qrp |
179 | c = cols qr | 179 | c = cols qrp |
180 | foreign import ccall "gsl-aux.h QRunpack" c_qrUnpack :: TMVMM | 180 | foreign import ccall "gsl-aux.h QRunpack" c_qrUnpack :: TMVMM |
181 | 181 | ||
182 | 182 | ||
@@ -259,7 +259,6 @@ luRaux' x = unsafePerformIO $ do | |||
259 | app2 c_luRaux mat x vec res "luRaux" | 259 | app2 c_luRaux mat x vec res "luRaux" |
260 | return res | 260 | return res |
261 | where r = rows x | 261 | where r = rows x |
262 | c = cols x | ||
263 | foreign import ccall "gsl-aux.h luRaux" c_luRaux :: TMV | 262 | foreign import ccall "gsl-aux.h luRaux" c_luRaux :: TMV |
264 | 263 | ||
265 | {- | lu decomposition of complex matrix (packed as a vector including l, u, the permutation and sign) | 264 | {- | lu decomposition of complex matrix (packed as a vector including l, u, the permutation and sign) |
@@ -272,7 +271,6 @@ luCaux' x = unsafePerformIO $ do | |||
272 | app2 c_luCaux mat x vec res "luCaux" | 271 | app2 c_luCaux mat x vec res "luCaux" |
273 | return res | 272 | return res |
274 | where r = rows x | 273 | where r = rows x |
275 | c = cols x | ||
276 | foreign import ccall "gsl-aux.h luCaux" c_luCaux :: TCMCV | 274 | foreign import ccall "gsl-aux.h luCaux" c_luCaux :: TCMCV |
277 | 275 | ||
278 | {- | The LU decomposition of a square matrix. Is based on /gsl_linalg_LU_decomp/ and /gsl_linalg_complex_LU_decomp/ as described in <http://www.gnu.org/software/Numeric.GSL/manual/Numeric.GSL-ref_13.html#SEC223>. | 276 | {- | The LU decomposition of a square matrix. Is based on /gsl_linalg_LU_decomp/ and /gsl_linalg_complex_LU_decomp/ as described in <http://www.gnu.org/software/Numeric.GSL/manual/Numeric.GSL-ref_13.html#SEC223>. |
diff --git a/lib/Numeric/GSL/Minimization.hs b/lib/Numeric/GSL/Minimization.hs index 235a88f..98c0ca9 100644 --- a/lib/Numeric/GSL/Minimization.hs +++ b/lib/Numeric/GSL/Minimization.hs | |||
@@ -24,7 +24,6 @@ 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 Complex | ||
28 | 27 | ||
29 | ------------------------------------------------------------------------- | 28 | ------------------------------------------------------------------------- |
30 | 29 | ||
@@ -84,9 +83,9 @@ minimizeNMSimplex f xi sz tol maxit = unsafePerformIO $ do | |||
84 | szv = fromList sz | 83 | szv = fromList sz |
85 | n = dim xiv | 84 | n = dim xiv |
86 | fp <- mkVecfun (iv (f.toList)) | 85 | fp <- mkVecfun (iv (f.toList)) |
87 | rawpath <- ww2 withVector xiv withVector szv $ \xiv szv -> | 86 | rawpath <- ww2 withVector xiv withVector szv $ \xiv' szv' -> |
88 | createMIO maxit (n+3) | 87 | createMIO maxit (n+3) |
89 | (c_minimizeNMSimplex fp tol maxit // xiv // szv) | 88 | (c_minimizeNMSimplex fp tol maxit // xiv' // szv') |
90 | "minimizeNMSimplex" | 89 | "minimizeNMSimplex" |
91 | let it = round (rawpath @@> (maxit-1,0)) | 90 | let it = round (rawpath @@> (maxit-1,0)) |
92 | path = takeRows it rawpath | 91 | path = takeRows it rawpath |
@@ -150,9 +149,9 @@ minimizeConjugateGradient istep minimpar tol maxit f df xi = unsafePerformIO $ d | |||
150 | df' = (fromList . df . toList) | 149 | df' = (fromList . df . toList) |
151 | fp <- mkVecfun (iv f') | 150 | fp <- mkVecfun (iv f') |
152 | dfp <- mkVecVecfun (aux_vTov df') | 151 | dfp <- mkVecVecfun (aux_vTov df') |
153 | rawpath <- withVector xiv $ \xiv -> | 152 | rawpath <- withVector xiv $ \xiv' -> |
154 | createMIO maxit (n+2) | 153 | createMIO maxit (n+2) |
155 | (c_minimizeConjugateGradient fp dfp istep minimpar tol maxit // xiv) | 154 | (c_minimizeConjugateGradient fp dfp istep minimpar tol maxit // xiv') |
156 | "minimizeDerivV" | 155 | "minimizeDerivV" |
157 | let it = round (rawpath @@> (maxit-1,0)) | 156 | let it = round (rawpath @@> (maxit-1,0)) |
158 | path = takeRows it rawpath | 157 | path = takeRows it rawpath |
@@ -171,8 +170,8 @@ foreign import ccall "gsl-aux.h minimizeWithDeriv" | |||
171 | --------------------------------------------------------------------- | 170 | --------------------------------------------------------------------- |
172 | iv :: (Vector Double -> Double) -> (Int -> Ptr Double -> Double) | 171 | iv :: (Vector Double -> Double) -> (Int -> Ptr Double -> Double) |
173 | iv f n p = f (createV n copy "iv") where | 172 | iv f n p = f (createV n copy "iv") where |
174 | copy n q = do | 173 | copy n' q = do |
175 | copyArray q p n | 174 | copyArray q p n' |
176 | return 0 | 175 | return 0 |
177 | 176 | ||
178 | -- | conversion of Haskell functions into function pointers that can be used in the C side | 177 | -- | conversion of Haskell functions into function pointers that can be used in the C side |
@@ -187,12 +186,12 @@ foreign import ccall "wrapper" | |||
187 | 186 | ||
188 | aux_vTov :: (Vector Double -> Vector Double) -> (Int -> Ptr Double -> Ptr Double -> IO()) | 187 | aux_vTov :: (Vector Double -> Vector Double) -> (Int -> Ptr Double -> Ptr Double -> IO()) |
189 | aux_vTov f n p r = g where | 188 | aux_vTov f n p r = g where |
190 | v@V {fptr = pr} = f x | 189 | V {fptr = pr} = f x |
191 | x = createV n copy "aux_vTov" | 190 | x = createV n copy "aux_vTov" |
192 | copy n q = do | 191 | copy n' q = do |
193 | copyArray q p n | 192 | copyArray q p n' |
194 | return 0 | 193 | return 0 |
195 | g = withForeignPtr pr $ \p -> copyArray r p n | 194 | g = withForeignPtr pr $ \p' -> copyArray r p' n |
196 | 195 | ||
197 | -------------------------------------------------------------------- | 196 | -------------------------------------------------------------------- |
198 | 197 | ||
@@ -202,6 +201,6 @@ createV n fun msg = unsafePerformIO $ do | |||
202 | return r | 201 | return r |
203 | 202 | ||
204 | createMIO r c fun msg = do | 203 | createMIO r c fun msg = do |
205 | r <- createMatrix RowMajor r c | 204 | res <- createMatrix RowMajor r c |
206 | app1 fun mat r msg | 205 | app1 fun mat res msg |
207 | return r | 206 | return res |
diff --git a/lib/Numeric/GSL/Special.hs b/lib/Numeric/GSL/Special.hs index b6cea2b..3fd2ac2 100644 --- a/lib/Numeric/GSL/Special.hs +++ b/lib/Numeric/GSL/Special.hs | |||
@@ -44,8 +44,6 @@ module Numeric.GSL.Special ( | |||
44 | ) | 44 | ) |
45 | where | 45 | where |
46 | 46 | ||
47 | import Foreign | ||
48 | import Numeric.GSL.Special.Internal | ||
49 | import Numeric.GSL.Special.Airy | 47 | import Numeric.GSL.Special.Airy |
50 | import Numeric.GSL.Special.Bessel | 48 | import Numeric.GSL.Special.Bessel |
51 | import Numeric.GSL.Special.Clausen | 49 | import Numeric.GSL.Special.Clausen |
diff --git a/lib/Numeric/LinearAlgebra.hs b/lib/Numeric/LinearAlgebra.hs index f3190a2..c14d4e4 100644 --- a/lib/Numeric/LinearAlgebra.hs +++ b/lib/Numeric/LinearAlgebra.hs | |||
@@ -23,5 +23,5 @@ module Numeric.LinearAlgebra ( | |||
23 | import Data.Packed | 23 | import Data.Packed |
24 | import Numeric.LinearAlgebra.Linear | 24 | import Numeric.LinearAlgebra.Linear |
25 | import Numeric.LinearAlgebra.Algorithms | 25 | import Numeric.LinearAlgebra.Algorithms |
26 | import Numeric.LinearAlgebra.Instances | 26 | import Numeric.LinearAlgebra.Instances() |
27 | import Numeric.LinearAlgebra.Interface | 27 | import Numeric.LinearAlgebra.Interface |
diff --git a/lib/Numeric/LinearAlgebra/Algorithms.hs b/lib/Numeric/LinearAlgebra/Algorithms.hs index fd16973..069d9a3 100644 --- a/lib/Numeric/LinearAlgebra/Algorithms.hs +++ b/lib/Numeric/LinearAlgebra/Algorithms.hs | |||
@@ -165,8 +165,8 @@ pinv m = linearSolveSVD m (ident (rows m)) | |||
165 | -- If @(u,d,v) = full svd m@ then @m == u \<> d \<> trans v@. | 165 | -- If @(u,d,v) = full svd m@ then @m == u \<> d \<> trans v@. |
166 | full :: Element t | 166 | full :: Element t |
167 | => (Matrix t -> (Matrix t, Vector Double, Matrix t)) -> Matrix t -> (Matrix t, Matrix Double, Matrix t) | 167 | => (Matrix t -> (Matrix t, Vector Double, Matrix t)) -> Matrix t -> (Matrix t, Matrix Double, Matrix t) |
168 | full svd m = (u, d ,v) where | 168 | full svd' m = (u, d ,v) where |
169 | (u,s,v) = svd m | 169 | (u,s,v) = svd' m |
170 | d = diagRect s r c | 170 | d = diagRect s r c |
171 | r = rows m | 171 | r = rows m |
172 | c = cols m | 172 | c = cols m |
@@ -176,12 +176,12 @@ full svd m = (u, d ,v) where | |||
176 | -- If @(u,s,v) = economy svd m@ then @m == u \<> diag s \<> trans v@. | 176 | -- If @(u,s,v) = economy svd m@ then @m == u \<> diag s \<> trans v@. |
177 | economy :: Element t | 177 | economy :: Element t |
178 | => (Matrix t -> (Matrix t, Vector Double, Matrix t)) -> Matrix t -> (Matrix t, Vector Double, Matrix t) | 178 | => (Matrix t -> (Matrix t, Vector Double, Matrix t)) -> Matrix t -> (Matrix t, Vector Double, Matrix t) |
179 | economy svd m = (u', subVector 0 d s, v') where | 179 | economy svd' m = (u', subVector 0 d s, v') where |
180 | (u,s,v) = svd m | 180 | (u,s,v) = svd' m |
181 | sl@(g:_) = toList s | 181 | sl@(g:_) = toList s |
182 | s' = fromList . filter (>tol) $ sl | 182 | s' = fromList . filter (>tol) $ sl |
183 | t = 1 | 183 | t = 1 |
184 | tol = (fromIntegral (max (rows m) (cols m)) * g * t * eps) | 184 | tol = (fromIntegral (max r c) * g * t * eps) |
185 | r = rows m | 185 | r = rows m |
186 | c = cols m | 186 | c = cols m |
187 | d = dim s' | 187 | d = dim s' |
@@ -273,8 +273,8 @@ nullspacePrec t m = ns where | |||
273 | (_,s,v) = svd m | 273 | (_,s,v) = svd m |
274 | sl@(g:_) = toList s | 274 | sl@(g:_) = toList s |
275 | tol = (fromIntegral (max (rows m) (cols m)) * g * t * eps) | 275 | tol = (fromIntegral (max (rows m) (cols m)) * g * t * eps) |
276 | rank = length (filter (> g*tol) sl) | 276 | rank' = length (filter (> g*tol) sl) |
277 | ns = drop rank $ toRows $ ctrans v | 277 | ns = drop rank' $ toRows $ ctrans v |
278 | 278 | ||
279 | -- | The nullspace of a matrix, assumed to be one-dimensional, with default tolerance (shortcut for @last . nullspacePrec 1@). | 279 | -- | The nullspace of a matrix, assumed to be one-dimensional, with default tolerance (shortcut for @last . nullspacePrec 1@). |
280 | nullVector :: Field t => Matrix t -> Vector t | 280 | nullVector :: Field t => Matrix t -> Vector t |
@@ -306,7 +306,7 @@ pinvTol t m = v' `mXm` diag s' `mXm` trans u' where | |||
306 | sl@(g:_) = toList s | 306 | sl@(g:_) = toList s |
307 | s' = fromList . map rec $ sl | 307 | s' = fromList . map rec $ sl |
308 | rec x = if x < g*tol then 1 else 1/x | 308 | rec x = if x < g*tol then 1 else 1/x |
309 | tol = (fromIntegral (max (rows m) (cols m)) * g * t * eps) | 309 | tol = (fromIntegral (max r c) * g * t * eps) |
310 | r = rows m | 310 | r = rows m |
311 | c = cols m | 311 | c = cols m |
312 | d = dim s | 312 | d = dim s |
@@ -368,10 +368,12 @@ rank :: Field t => Matrix t -> Int | |||
368 | rank m | pnorm PNorm1 m < eps = 0 | 368 | rank m | pnorm PNorm1 m < eps = 0 |
369 | | otherwise = dim s where (_,s,_) = economy svd m | 369 | | otherwise = dim s where (_,s,_) = economy svd m |
370 | 370 | ||
371 | {- | ||
371 | expm' m = case diagonalize (complex m) of | 372 | expm' m = case diagonalize (complex m) of |
372 | Just (l,v) -> v `mXm` diag (exp l) `mXm` inv v | 373 | Just (l,v) -> v `mXm` diag (exp l) `mXm` inv v |
373 | Nothing -> error "Sorry, expm not yet implemented for non-diagonalizable matrices" | 374 | Nothing -> error "Sorry, expm not yet implemented for non-diagonalizable matrices" |
374 | where exp = vectorMapC Exp | 375 | where exp = vectorMapC Exp |
376 | -} | ||
375 | 377 | ||
376 | diagonalize m = if rank v == n | 378 | diagonalize m = if rank v == n |
377 | then Just (l,v) | 379 | then Just (l,v) |
@@ -406,7 +408,7 @@ geps delta = head [ k | (k,g) <- epslist, g<delta] | |||
406 | expGolub m = iterate msq f !! j | 408 | expGolub m = iterate msq f !! j |
407 | where j = max 0 $ floor $ log2 $ pnorm Infinity m | 409 | where j = max 0 $ floor $ log2 $ pnorm Infinity m |
408 | log2 x = log x / log 2 | 410 | log2 x = log x / log 2 |
409 | a = m */ fromIntegral (2^j) | 411 | a = m */ fromIntegral ((2::Int)^j) |
410 | q = geps eps -- 7 steps | 412 | q = geps eps -- 7 steps |
411 | eye = ident (rows m) | 413 | eye = ident (rows m) |
412 | work (k,c,x,n,d) = (k',c',x',n',d') | 414 | work (k,c,x,n,d) = (k',c',x',n',d') |
@@ -415,9 +417,9 @@ expGolub m = iterate msq f !! j | |||
415 | x' = a <> x | 417 | x' = a <> x |
416 | n' = n |+| (c' .* x') | 418 | n' = n |+| (c' .* x') |
417 | d' = d |+| (((-1)^k * c') .* x') | 419 | d' = d |+| (((-1)^k * c') .* x') |
418 | (_,_,_,n,d) = iterate work (1,1,eye,eye,eye) !! q | 420 | (_,_,_,nf,df) = iterate work (1,1,eye,eye,eye) !! q |
419 | f = linearSolve d n | 421 | f = linearSolve df nf |
420 | msq m = m <> m | 422 | msq x = x <> x |
421 | 423 | ||
422 | (<>) = multiply | 424 | (<>) = multiply |
423 | v */ x = scale (recip x) v | 425 | v */ x = scale (recip x) v |
@@ -446,9 +448,10 @@ It only works with invertible matrices that have a real solution. For diagonaliz | |||
446 | sqrtm :: Field t => Matrix t -> Matrix t | 448 | sqrtm :: Field t => Matrix t -> Matrix t |
447 | sqrtm = sqrtmInv | 449 | sqrtm = sqrtmInv |
448 | 450 | ||
449 | sqrtmInv a = fst $ fixedPoint $ iterate f (a, ident (rows a)) | 451 | sqrtmInv x = fst $ fixedPoint $ iterate f (x, ident (rows x)) |
450 | where fixedPoint (a:b:rest) | pnorm PNorm1 (fst a |-| fst b) < eps = a | 452 | where fixedPoint (a:b:rest) | pnorm PNorm1 (fst a |-| fst b) < eps = a |
451 | | otherwise = fixedPoint (b:rest) | 453 | | otherwise = fixedPoint (b:rest) |
454 | fixedPoint _ = error "fixedpoint with impossible inputs" | ||
452 | f (y,z) = (0.5 .* (y |+| inv z), | 455 | f (y,z) = (0.5 .* (y |+| inv z), |
453 | 0.5 .* (inv y |+| z)) | 456 | 0.5 .* (inv y |+| z)) |
454 | (.*) = scale | 457 | (.*) = scale |
diff --git a/lib/Numeric/LinearAlgebra/LAPACK.hs b/lib/Numeric/LinearAlgebra/LAPACK.hs index 936cb19..cacad87 100644 --- a/lib/Numeric/LinearAlgebra/LAPACK.hs +++ b/lib/Numeric/LinearAlgebra/LAPACK.hs | |||
@@ -120,11 +120,12 @@ eigRaux m | |||
120 | where r = rows m | 120 | where r = rows m |
121 | 121 | ||
122 | fixeig [] _ = [] | 122 | fixeig [] _ = [] |
123 | fixeig [r] [v] = [comp v] | 123 | fixeig [_] [v] = [comp v] |
124 | fixeig ((r1:+i1):(r2:+i2):r) (v1:v2:vs) | 124 | fixeig ((r1:+i1):(r2:+i2):r) (v1:v2:vs) |
125 | | r1 == r2 && i1 == (-i2) = toComplex (v1,v2) : toComplex (v1,scale (-1) v2) : fixeig r vs | 125 | | r1 == r2 && i1 == (-i2) = toComplex (v1,v2) : toComplex (v1,scale (-1) v2) : fixeig r vs |
126 | | otherwise = comp v1 : fixeig ((r2:+i2):r) (v2:vs) | 126 | | otherwise = comp v1 : fixeig ((r2:+i2):r) (v2:vs) |
127 | where scale = vectorMapValR Scale | 127 | where scale = vectorMapValR Scale |
128 | fixeig _ _ = error "fixeig with impossible inputs" | ||
128 | 129 | ||
129 | ----------------------------------------------------------------------------- | 130 | ----------------------------------------------------------------------------- |
130 | 131 | ||
diff --git a/lib/Numeric/LinearAlgebra/Linear.hs b/lib/Numeric/LinearAlgebra/Linear.hs index 3403591..a39df50 100644 --- a/lib/Numeric/LinearAlgebra/Linear.hs +++ b/lib/Numeric/LinearAlgebra/Linear.hs | |||
@@ -20,7 +20,7 @@ module Numeric.LinearAlgebra.Linear ( | |||
20 | ) where | 20 | ) where |
21 | 21 | ||
22 | 22 | ||
23 | import Data.Packed.Internal(multiply,at,partit) | 23 | import Data.Packed.Internal(multiply,partit) |
24 | import Data.Packed | 24 | import Data.Packed |
25 | import Numeric.GSL.Vector | 25 | import Numeric.GSL.Vector |
26 | import Complex | 26 | import Complex |