diff options
author | Alberto Ruiz <aruiz@um.es> | 2010-09-08 08:14:27 +0000 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2010-09-08 08:14:27 +0000 |
commit | a858bf910291b63603a226c3190ecb36de01b5ba (patch) | |
tree | 1c855b7e29175c8497e3a68c6d3547930ed69d6a /lib/Numeric/Matrix.hs | |
parent | 7e103b8ada6fa1479790eac80eda997f5fdaf33f (diff) |
re-export changes
Diffstat (limited to 'lib/Numeric/Matrix.hs')
-rw-r--r-- | lib/Numeric/Matrix.hs | 157 |
1 files changed, 109 insertions, 48 deletions
diff --git a/lib/Numeric/Matrix.hs b/lib/Numeric/Matrix.hs index fa3f94a..6ba870f 100644 --- a/lib/Numeric/Matrix.hs +++ b/lib/Numeric/Matrix.hs | |||
@@ -3,6 +3,7 @@ | |||
3 | {-# LANGUAGE FlexibleInstances #-} | 3 | {-# LANGUAGE FlexibleInstances #-} |
4 | {-# LANGUAGE UndecidableInstances #-} | 4 | {-# LANGUAGE UndecidableInstances #-} |
5 | {-# LANGUAGE MultiParamTypeClasses #-} | 5 | {-# LANGUAGE MultiParamTypeClasses #-} |
6 | {-# LANGUAGE FunctionalDependencies #-} | ||
6 | 7 | ||
7 | ----------------------------------------------------------------------------- | 8 | ----------------------------------------------------------------------------- |
8 | -- | | 9 | -- | |
@@ -14,12 +15,22 @@ | |||
14 | -- Stability : provisional | 15 | -- Stability : provisional |
15 | -- Portability : portable | 16 | -- Portability : portable |
16 | -- | 17 | -- |
17 | -- Numeric instances and functions for 'Data.Packed.Matrix's | 18 | -- Numeric instances and functions for 'Matrix'. |
19 | -- In the context of the standard numeric operators, one-component | ||
20 | -- vectors and matrices automatically expand to match the dimensions of the other operand. | ||
18 | -- | 21 | -- |
19 | ----------------------------------------------------------------------------- | 22 | ----------------------------------------------------------------------------- |
20 | 23 | ||
21 | module Numeric.Matrix ( | 24 | module Numeric.Matrix ( |
22 | module Data.Packed.Matrix, | 25 | -- * Basic functions |
26 | module Data.Packed.Matrix, | ||
27 | module Numeric.Vector, | ||
28 | --module Numeric.Container, | ||
29 | -- * Operators | ||
30 | (<>), (<\>), | ||
31 | -- * Deprecated | ||
32 | (.*),(*/),(<|>),(<->), | ||
33 | vectorMax,vectorMin | ||
23 | ) where | 34 | ) where |
24 | 35 | ||
25 | ------------------------------------------------------------------- | 36 | ------------------------------------------------------------------- |
@@ -28,18 +39,18 @@ import Data.Packed.Vector | |||
28 | import Data.Packed.Matrix | 39 | import Data.Packed.Matrix |
29 | import Numeric.Container | 40 | import Numeric.Container |
30 | --import Numeric.LinearAlgebra.Linear | 41 | --import Numeric.LinearAlgebra.Linear |
31 | import Numeric.Vector() | 42 | import Numeric.Vector |
43 | import Numeric.LinearAlgebra.Algorithms | ||
44 | --import Control.Monad(ap) | ||
32 | 45 | ||
33 | import Control.Monad(ap) | 46 | --import Control.Arrow((***)) |
34 | |||
35 | import Control.Arrow((***)) | ||
36 | 47 | ||
37 | ------------------------------------------------------------------- | 48 | ------------------------------------------------------------------- |
38 | 49 | ||
39 | instance Linear Matrix a => Eq (Matrix a) where | 50 | instance Container Matrix a => Eq (Matrix a) where |
40 | (==) = equal | 51 | (==) = equal |
41 | 52 | ||
42 | instance (Linear Matrix a, Num (Vector a)) => Num (Matrix a) where | 53 | instance (Container Matrix a, Num (Vector a)) => Num (Matrix a) where |
43 | (+) = liftMatrix2Auto (+) | 54 | (+) = liftMatrix2Auto (+) |
44 | (-) = liftMatrix2Auto (-) | 55 | (-) = liftMatrix2Auto (-) |
45 | negate = liftMatrix negate | 56 | negate = liftMatrix negate |
@@ -50,13 +61,13 @@ instance (Linear Matrix a, Num (Vector a)) => Num (Matrix a) where | |||
50 | 61 | ||
51 | --------------------------------------------------- | 62 | --------------------------------------------------- |
52 | 63 | ||
53 | instance (Linear Vector a, Fractional (Vector a), Num (Matrix a)) => Fractional (Matrix a) where | 64 | instance (Container Vector a, Fractional (Vector a), Num (Matrix a)) => Fractional (Matrix a) where |
54 | fromRational n = (1><1) [fromRational n] | 65 | fromRational n = (1><1) [fromRational n] |
55 | (/) = liftMatrix2Auto (/) | 66 | (/) = liftMatrix2Auto (/) |
56 | 67 | ||
57 | --------------------------------------------------------- | 68 | --------------------------------------------------------- |
58 | 69 | ||
59 | instance (Linear Vector a, Floating (Vector a), Fractional (Matrix a)) => Floating (Matrix a) where | 70 | instance (Container Vector a, Floating (Vector a), Fractional (Matrix a)) => Floating (Matrix a) where |
60 | sin = liftMatrix sin | 71 | sin = liftMatrix sin |
61 | cos = liftMatrix cos | 72 | cos = liftMatrix cos |
62 | tan = liftMatrix tan | 73 | tan = liftMatrix tan |
@@ -75,43 +86,93 @@ instance (Linear Vector a, Floating (Vector a), Fractional (Matrix a)) => Floati | |||
75 | sqrt = liftMatrix sqrt | 86 | sqrt = liftMatrix sqrt |
76 | pi = (1><1) [pi] | 87 | pi = (1><1) [pi] |
77 | 88 | ||
78 | --------------------------------------------------------------- | 89 | -------------------------------------------------------- |
79 | 90 | ||
80 | instance NumericContainer Matrix where | 91 | class Mul a b c | a b -> c where |
81 | toComplex = uncurry $ liftMatrix2 $ curry toComplex | 92 | infixl 7 <> |
82 | fromComplex z = (reshape c *** reshape c) . fromComplex . flatten $ z | 93 | -- | Matrix-matrix, matrix-vector, and vector-matrix products. |
83 | where c = cols z | 94 | (<>) :: Product t => a t -> b t -> c t |
84 | complex' = liftMatrix complex' | 95 | |
85 | conj = liftMatrix conj | 96 | instance Mul Matrix Matrix Matrix where |
86 | -- cmap f = liftMatrix (cmap f) | 97 | (<>) = mXm |
87 | single' = liftMatrix single' | 98 | |
88 | double' = liftMatrix double' | 99 | instance Mul Matrix Vector Vector where |
89 | 100 | (<>) m v = flatten $ m <> (asColumn v) | |
90 | --------------------------------------------------------------- | 101 | |
91 | 102 | instance Mul Vector Matrix Vector where | |
92 | instance (Linear Vector a, Container Matrix a) => Linear Matrix a where | 103 | (<>) v m = flatten $ (asRow v) <> m |
93 | scale x = liftMatrix (scale x) | ||
94 | scaleRecip x = liftMatrix (scaleRecip x) | ||
95 | addConstant x = liftMatrix (addConstant x) | ||
96 | add = liftMatrix2 add | ||
97 | sub = liftMatrix2 sub | ||
98 | mul = liftMatrix2 mul | ||
99 | divide = liftMatrix2 divide | ||
100 | equal a b = cols a == cols b && flatten a `equal` flatten b | ||
101 | scalar x = (1><1) [x] | ||
102 | -- | ||
103 | instance (Container Vector a) => Container Matrix a where | ||
104 | cmap f = liftMatrix (mapVector f) | ||
105 | atIndex = (@@>) | ||
106 | minIndex m = let (r,c) = (rows m,cols m) | ||
107 | i = (minIndex $ flatten m) | ||
108 | in (i `div` c,(i `mod` c) + 1) | ||
109 | maxIndex m = let (r,c) = (rows m,cols m) | ||
110 | i = (maxIndex $ flatten m) | ||
111 | in (i `div` c,(i `mod` c) + 1) | ||
112 | minElement = ap (@@>) minIndex | ||
113 | maxElement = ap (@@>) maxIndex | ||
114 | sumElements = sumElements . flatten | ||
115 | prodElements = prodElements . flatten | ||
116 | 104 | ||
117 | ---------------------------------------------------- | 105 | ---------------------------------------------------- |
106 | |||
107 | {-# DEPRECATED (.*) "use scale a x or scalar a * x" #-} | ||
108 | |||
109 | -- -- | @x .* a = scale x a@ | ||
110 | -- (.*) :: (Linear c a) => a -> c a -> c a | ||
111 | infixl 7 .* | ||
112 | a .* x = scale a x | ||
113 | |||
114 | ---------------------------------------------------- | ||
115 | |||
116 | {-# DEPRECATED (*/) "use scale (recip a) x or x / scalar a" #-} | ||
117 | |||
118 | -- -- | @a *\/ x = scale (recip x) a@ | ||
119 | -- (*/) :: (Linear c a) => c a -> a -> c a | ||
120 | infixl 7 */ | ||
121 | v */ x = scale (recip x) v | ||
122 | |||
123 | -- | least squares solution of a linear system, similar to the \\ operator of Matlab\/Octave (based on linearSolveSVD). | ||
124 | (<\>) :: (Field a) => Matrix a -> Vector a -> Vector a | ||
125 | infixl 7 <\> | ||
126 | m <\> v = flatten (linearSolveSVD m (reshape 1 v)) | ||
127 | |||
128 | ------------------------------------------------ | ||
129 | |||
130 | {-# DEPRECATED (<|>) "define operator a & b = fromBlocks[[a,b]] and use asRow/asColumn to join vectors" #-} | ||
131 | {-# DEPRECATED (<->) "define operator a // b = fromBlocks[[a],[b]] and use asRow/asColumn to join vectors" #-} | ||
132 | |||
133 | class Joinable a b where | ||
134 | joinH :: Element t => a t -> b t -> Matrix t | ||
135 | joinV :: Element t => a t -> b t -> Matrix t | ||
136 | |||
137 | instance Joinable Matrix Matrix where | ||
138 | joinH m1 m2 = fromBlocks [[m1,m2]] | ||
139 | joinV m1 m2 = fromBlocks [[m1],[m2]] | ||
140 | |||
141 | instance Joinable Matrix Vector where | ||
142 | joinH m v = joinH m (asColumn v) | ||
143 | joinV m v = joinV m (asRow v) | ||
144 | |||
145 | instance Joinable Vector Matrix where | ||
146 | joinH v m = joinH (asColumn v) m | ||
147 | joinV v m = joinV (asRow v) m | ||
148 | |||
149 | infixl 4 <|> | ||
150 | infixl 3 <-> | ||
151 | |||
152 | {-- - | Horizontal concatenation of matrices and vectors: | ||
153 | |||
154 | @> (ident 3 \<-\> 3 * ident 3) \<|\> fromList [1..6.0] | ||
155 | (6><4) | ||
156 | [ 1.0, 0.0, 0.0, 1.0 | ||
157 | , 0.0, 1.0, 0.0, 2.0 | ||
158 | , 0.0, 0.0, 1.0, 3.0 | ||
159 | , 3.0, 0.0, 0.0, 4.0 | ||
160 | , 0.0, 3.0, 0.0, 5.0 | ||
161 | , 0.0, 0.0, 3.0, 6.0 ]@ | ||
162 | -} | ||
163 | -- (<|>) :: (Element t, Joinable a b) => a t -> b t -> Matrix t | ||
164 | a <|> b = joinH a b | ||
165 | |||
166 | -- -- | Vertical concatenation of matrices and vectors. | ||
167 | -- (<->) :: (Element t, Joinable a b) => a t -> b t -> Matrix t | ||
168 | a <-> b = joinV a b | ||
169 | |||
170 | ------------------------------------------------------------------- | ||
171 | |||
172 | {-# DEPRECATED vectorMin "use minElement" #-} | ||
173 | vectorMin :: (Container Vector t, Element t) => Vector t -> t | ||
174 | vectorMin = minElement | ||
175 | |||
176 | {-# DEPRECATED vectorMax "use maxElement" #-} | ||
177 | vectorMax :: (Container Vector t, Element t) => Vector t -> t | ||
178 | vectorMax = maxElement | ||