diff options
-rw-r--r-- | HSSL.cabal | 1 | ||||
-rw-r--r-- | lib/Data/Packed/Matrix.hs | 53 | ||||
-rw-r--r-- | lib/LinearAlgebra.hs | 4 | ||||
-rw-r--r-- | lib/LinearAlgebra/Algorithms.hs | 2 | ||||
-rw-r--r-- | lib/LinearAlgebra/Interface.hs | 99 | ||||
-rw-r--r-- | lib/LinearAlgebra/Linear.hs | 20 |
6 files changed, 156 insertions, 23 deletions
@@ -49,6 +49,7 @@ Exposed-modules: Data.Packed.Internal, | |||
49 | LinearAlgebra, | 49 | LinearAlgebra, |
50 | LinearAlgebra.Linear, | 50 | LinearAlgebra.Linear, |
51 | LinearAlgebra.Instances, | 51 | LinearAlgebra.Instances, |
52 | LinearAlgebra.Interface, | ||
52 | LinearAlgebra.Algorithms | 53 | LinearAlgebra.Algorithms |
53 | , Graphics.Plot | 54 | , Graphics.Plot |
54 | -- , GSLHaskell | 55 | -- , GSLHaskell |
diff --git a/lib/Data/Packed/Matrix.hs b/lib/Data/Packed/Matrix.hs index 4f2ad90..5a4b919 100644 --- a/lib/Data/Packed/Matrix.hs +++ b/lib/Data/Packed/Matrix.hs | |||
@@ -1,3 +1,4 @@ | |||
1 | {-# OPTIONS_GHC -fglasgow-exts #-} | ||
1 | ----------------------------------------------------------------------------- | 2 | ----------------------------------------------------------------------------- |
2 | -- | | 3 | -- | |
3 | -- Module : Data.Packed.Matrix | 4 | -- Module : Data.Packed.Matrix |
@@ -21,17 +22,21 @@ module Data.Packed.Matrix ( | |||
21 | trans, conjTrans, | 22 | trans, conjTrans, |
22 | asRow, asColumn, | 23 | asRow, asColumn, |
23 | fromRows, toRows, fromColumns, toColumns, | 24 | fromRows, toRows, fromColumns, toColumns, |
24 | fromBlocks, joinVert, joinHoriz, | 25 | fromBlocks, |
25 | flipud, fliprl, | 26 | flipud, fliprl, |
26 | subMatrix, takeRows, dropRows, takeColumns, dropColumns, | 27 | subMatrix, takeRows, dropRows, takeColumns, dropColumns, |
27 | ident, diag, diagRect, takeDiag, | 28 | ident, diag, diagRect, takeDiag, |
28 | liftMatrix, liftMatrix2, | 29 | liftMatrix, liftMatrix2, |
30 | dispR, readMatrix, fromArray2D | ||
29 | ) where | 31 | ) where |
30 | 32 | ||
31 | import Data.Packed.Internal | 33 | import Data.Packed.Internal |
32 | import Foreign(Storable) | 34 | import Foreign(Storable) |
33 | import Complex | 35 | import Complex |
34 | import Data.Packed.Vector | 36 | import Data.Packed.Vector |
37 | import Numeric(showGFloat) | ||
38 | import Data.List(transpose,intersperse) | ||
39 | import Data.Array | ||
35 | 40 | ||
36 | -- | creates a matrix from a vertical list of matrices | 41 | -- | creates a matrix from a vertical list of matrices |
37 | joinVert :: Field t => [Matrix t] -> Matrix t | 42 | joinVert :: Field t => [Matrix t] -> Matrix t |
@@ -160,5 +165,47 @@ asRow v = reshape (dim v) v | |||
160 | asColumn :: Field a => Vector a -> Matrix a | 165 | asColumn :: Field a => Vector a -> Matrix a |
161 | asColumn v = reshape 1 v | 166 | asColumn v = reshape 1 v |
162 | 167 | ||
163 | ------------------------------------------------ | 168 | ----------------------------------------------------- |
164 | 169 | ||
170 | fromArray2D :: (Field e) => Array (Int, Int) e -> Matrix e | ||
171 | fromArray2D m = (r><c) (elems m) | ||
172 | where ((r0,c0),(r1,c1)) = bounds m | ||
173 | r = r1-r0+1 | ||
174 | c = c1-c0+1 | ||
175 | |||
176 | ------------------------------------------------------ | ||
177 | -- shows a Double with n digits after the decimal point | ||
178 | shf :: (RealFloat a) => Int -> a -> String | ||
179 | shf dec n | abs n < 1e-10 = "0." | ||
180 | | abs (n - (fromIntegral.round $ n)) < 1e-10 = show (round n) ++"." | ||
181 | | otherwise = showGFloat (Just dec) n "" | ||
182 | -- shows a Complex Double as a pair, with n digits after the decimal point | ||
183 | shfc n z@ (a:+b) | ||
184 | | magnitude z <1e-10 = "0." | ||
185 | | abs b < 1e-10 = shf n a | ||
186 | | abs a < 1e-10 = shf n b ++"i" | ||
187 | | b > 0 = shf n a ++"+"++shf n b ++"i" | ||
188 | | otherwise = shf n a ++shf n b ++"i" | ||
189 | |||
190 | dsp' :: String -> [[String]] -> String | ||
191 | dsp' sep as = unlines . map unwords' $ transpose mtp where | ||
192 | mt = transpose as | ||
193 | longs = map (maximum . map length) mt | ||
194 | mtp = zipWith (\a b -> map (pad a) b) longs mt | ||
195 | pad n str = replicate (n - length str) ' ' ++ str | ||
196 | unwords' = concat . intersperse sep | ||
197 | |||
198 | format :: (Field t) => String -> (t -> String) -> Matrix t -> String | ||
199 | format sep f m = dsp' sep . map (map f) . toLists $ m | ||
200 | |||
201 | disp m f = putStrLn $ "matrix ("++show (rows m) ++"x"++ show (cols m) ++")\n"++format " | " f m | ||
202 | |||
203 | dispR :: Int -> Matrix Double -> IO () | ||
204 | dispR d m = disp m (shf d) | ||
205 | |||
206 | dispC :: Int -> Matrix (Complex Double) -> IO () | ||
207 | dispC d m = disp m (shfc d) | ||
208 | |||
209 | -- | creates a matrix from a table of numbers. | ||
210 | readMatrix :: String -> Matrix Double | ||
211 | readMatrix = fromLists . map (map read). map words . filter (not.null) . lines | ||
diff --git a/lib/LinearAlgebra.hs b/lib/LinearAlgebra.hs index 3b56fc4..a271592 100644 --- a/lib/LinearAlgebra.hs +++ b/lib/LinearAlgebra.hs | |||
@@ -16,6 +16,8 @@ module LinearAlgebra ( | |||
16 | module Data.Packed.Vector, | 16 | module Data.Packed.Vector, |
17 | module Data.Packed.Matrix, | 17 | module Data.Packed.Matrix, |
18 | module LinearAlgebra.Linear, | 18 | module LinearAlgebra.Linear, |
19 | module LinearAlgebra.Instances, | ||
20 | module LinearAlgebra.Interface, | ||
19 | module LAPACK, | 21 | module LAPACK, |
20 | module GSL.Matrix, | 22 | module GSL.Matrix, |
21 | module LinearAlgebra.Algorithms, | 23 | module LinearAlgebra.Algorithms, |
@@ -23,6 +25,8 @@ module LinearAlgebra ( | |||
23 | ) where | 25 | ) where |
24 | 26 | ||
25 | import LinearAlgebra.Linear | 27 | import LinearAlgebra.Linear |
28 | import LinearAlgebra.Instances | ||
29 | import LinearAlgebra.Interface | ||
26 | import LinearAlgebra.Algorithms | 30 | import LinearAlgebra.Algorithms |
27 | import LAPACK | 31 | import LAPACK |
28 | import GSL.Matrix | 32 | import GSL.Matrix |
diff --git a/lib/LinearAlgebra/Algorithms.hs b/lib/LinearAlgebra/Algorithms.hs index 192c0d6..3112ce6 100644 --- a/lib/LinearAlgebra/Algorithms.hs +++ b/lib/LinearAlgebra/Algorithms.hs | |||
@@ -14,7 +14,7 @@ Portability : uses ffi | |||
14 | ----------------------------------------------------------------------------- | 14 | ----------------------------------------------------------------------------- |
15 | 15 | ||
16 | module LinearAlgebra.Algorithms ( | 16 | module LinearAlgebra.Algorithms ( |
17 | mXv, vXm, | 17 | -- mXv, vXm, |
18 | inv, | 18 | inv, |
19 | pinv, | 19 | pinv, |
20 | pinvTol, | 20 | pinvTol, |
diff --git a/lib/LinearAlgebra/Interface.hs b/lib/LinearAlgebra/Interface.hs new file mode 100644 index 0000000..7d6ff0f --- /dev/null +++ b/lib/LinearAlgebra/Interface.hs | |||
@@ -0,0 +1,99 @@ | |||
1 | {-# OPTIONS_GHC -fglasgow-exts #-} | ||
2 | ----------------------------------------------------------------------------- | ||
3 | {- | | ||
4 | Module : LinearAlgebra.Interface | ||
5 | Copyright : (c) Alberto Ruiz 2006 | ||
6 | License : GPL-style | ||
7 | |||
8 | Maintainer : Alberto Ruiz (aruiz at um dot es) | ||
9 | Stability : provisional | ||
10 | Portability : portable | ||
11 | |||
12 | Operators for frequent operations. | ||
13 | |||
14 | -} | ||
15 | ----------------------------------------------------------------------------- | ||
16 | |||
17 | module LinearAlgebra.Interface( | ||
18 | (<>),(<.>), | ||
19 | (.*),(*/), | ||
20 | (<|>),(<->), | ||
21 | ) where | ||
22 | |||
23 | import LinearAlgebra.Linear | ||
24 | import Data.Packed.Vector | ||
25 | import Data.Packed.Matrix | ||
26 | |||
27 | class Mul a b c | a b -> c where | ||
28 | infixl 7 <> | ||
29 | -- | matrix product | ||
30 | (<>) :: Field t => a t -> b t -> c t | ||
31 | |||
32 | instance Mul Matrix Matrix Matrix where | ||
33 | (<>) = multiply | ||
34 | |||
35 | instance Mul Matrix Vector Vector where | ||
36 | (<>) m v = flatten $ m <> (asColumn v) | ||
37 | |||
38 | instance Mul Vector Matrix Vector where | ||
39 | (<>) v m = flatten $ (asRow v) <> m | ||
40 | |||
41 | --------------------------------------------------- | ||
42 | |||
43 | -- | @u \<.\> v = dot u v@ | ||
44 | (<.>) :: (Field t) => Vector t -> Vector t -> t | ||
45 | infixl 7 <.> | ||
46 | (<.>) = dot | ||
47 | |||
48 | ---------------------------------------------------- | ||
49 | |||
50 | -- | @x .* a = scale (recip x) v@ | ||
51 | (.*) :: (Linear c a) => a -> c a -> c a | ||
52 | infixl 7 .* | ||
53 | a .* x = scale a x | ||
54 | |||
55 | ---------------------------------------------------- | ||
56 | |||
57 | -- | @a *\/ x = scale (recip x) a@ | ||
58 | (*/) :: (Linear c a) => c a -> a -> c a | ||
59 | infixl 7 */ | ||
60 | v */ x = scale (recip x) v | ||
61 | |||
62 | ------------------------------------------------ | ||
63 | |||
64 | class Joinable a b where | ||
65 | joinH :: Field t => a t -> b t -> Matrix t | ||
66 | joinV :: Field t => a t -> b t -> Matrix t | ||
67 | |||
68 | instance Joinable Matrix Matrix where | ||
69 | joinH m1 m2 = fromBlocks [[m1,m2]] | ||
70 | joinV m1 m2 = fromBlocks [[m1],[m2]] | ||
71 | |||
72 | instance Joinable Matrix Vector where | ||
73 | joinH m v = joinH m (asColumn v) | ||
74 | joinV m v = joinV m (asRow v) | ||
75 | |||
76 | instance Joinable Vector Matrix where | ||
77 | joinH v m = joinH (asColumn v) m | ||
78 | joinV v m = joinV (asRow v) m | ||
79 | |||
80 | infixl 4 <|> | ||
81 | infixl 3 <-> | ||
82 | |||
83 | {- | Horizontal concatenation of matrices and vectors: | ||
84 | |||
85 | @> (ident 3 -&- 3 * ident 3) |&| fromList [1..6.0] | ||
86 | (6><4) | ||
87 | [ 1.0, 0.0, 0.0, 1.0 | ||
88 | , 0.0, 1.0, 0.0, 2.0 | ||
89 | , 0.0, 0.0, 1.0, 3.0 | ||
90 | , 3.0, 0.0, 0.0, 4.0 | ||
91 | , 0.0, 3.0, 0.0, 5.0 | ||
92 | , 0.0, 0.0, 3.0, 6.0 ]@ | ||
93 | -} | ||
94 | (<|>) :: (Field t, Joinable a b) => a t -> b t -> Matrix t | ||
95 | a <|> b = joinH a b | ||
96 | |||
97 | -- | Vertical concatenation of matrices and vectors. | ||
98 | (<->) :: (Field t, Joinable a b) => a t -> b t -> Matrix t | ||
99 | a <-> b = joinV a b | ||
diff --git a/lib/LinearAlgebra/Linear.hs b/lib/LinearAlgebra/Linear.hs index 148bbd3..c12e30b 100644 --- a/lib/LinearAlgebra/Linear.hs +++ b/lib/LinearAlgebra/Linear.hs | |||
@@ -15,8 +15,7 @@ Portability : uses ffi | |||
15 | 15 | ||
16 | module LinearAlgebra.Linear ( | 16 | module LinearAlgebra.Linear ( |
17 | Linear(..), | 17 | Linear(..), |
18 | dot, outer, | 18 | multiply, dot, outer |
19 | Mul(..) | ||
20 | ) where | 19 | ) where |
21 | 20 | ||
22 | 21 | ||
@@ -95,7 +94,6 @@ instance Linear Matrix (Complex Double) where | |||
95 | 94 | ||
96 | -------------------------------------------------- | 95 | -------------------------------------------------- |
97 | 96 | ||
98 | |||
99 | -- | euclidean inner product | 97 | -- | euclidean inner product |
100 | dot :: (Field t) => Vector t -> Vector t -> t | 98 | dot :: (Field t) => Vector t -> Vector t -> t |
101 | dot u v = dat (multiply r c) `at` 0 | 99 | dot u v = dat (multiply r c) `at` 0 |
@@ -113,19 +111,3 @@ dot u v = dat (multiply r c) `at` 0 | |||
113 | -} | 111 | -} |
114 | outer :: (Field t) => Vector t -> Vector t -> Matrix t | 112 | outer :: (Field t) => Vector t -> Vector t -> Matrix t |
115 | outer u v = asColumn u `multiply` asRow v | 113 | outer u v = asColumn u `multiply` asRow v |
116 | |||
117 | |||
118 | class Mul a b c | a b -> c where | ||
119 | infixl 7 <> | ||
120 | -- | matrix product | ||
121 | (<>) :: Field t => a t -> b t -> c t | ||
122 | |||
123 | instance Mul Matrix Matrix Matrix where | ||
124 | (<>) = multiply | ||
125 | |||
126 | instance Mul Matrix Vector Vector where | ||
127 | (<>) m v = flatten $ m <> (asColumn v) | ||
128 | |||
129 | instance Mul Vector Matrix Vector where | ||
130 | (<>) v m = flatten $ (asRow v) <> m | ||
131 | |||