diff options
-rw-r--r-- | examples/Real.hs | 4 | ||||
-rw-r--r-- | lib/Data/Packed/Random.hs | 10 | ||||
-rw-r--r-- | lib/Numeric/Container.hs | 19 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/Algorithms.hs | 8 |
4 files changed, 17 insertions, 24 deletions
diff --git a/examples/Real.hs b/examples/Real.hs index b32a961..02eba9f 100644 --- a/examples/Real.hs +++ b/examples/Real.hs | |||
@@ -67,13 +67,13 @@ diagl = diag . vector | |||
67 | zeros :: Int -- ^ rows | 67 | zeros :: Int -- ^ rows |
68 | -> Int -- ^ columns | 68 | -> Int -- ^ columns |
69 | -> Matrix Double | 69 | -> Matrix Double |
70 | zeros r c = reshape c (constant 0 (r*c)) | 70 | zeros r c = konst 0 (r,c) |
71 | 71 | ||
72 | -- | Create a matrix or ones. | 72 | -- | Create a matrix or ones. |
73 | ones :: Int -- ^ rows | 73 | ones :: Int -- ^ rows |
74 | -> Int -- ^ columns | 74 | -> Int -- ^ columns |
75 | -> Matrix Double | 75 | -> Matrix Double |
76 | ones r c = reshape c (constant 1 (r*c)) | 76 | ones r c = konst 1 (r,c) |
77 | 77 | ||
78 | -- | Concatenation of real vectors. | 78 | -- | Concatenation of real vectors. |
79 | infixl 9 # | 79 | infixl 9 # |
diff --git a/lib/Data/Packed/Random.hs b/lib/Data/Packed/Random.hs index b30b299..c34f212 100644 --- a/lib/Data/Packed/Random.hs +++ b/lib/Data/Packed/Random.hs | |||
@@ -22,10 +22,8 @@ module Data.Packed.Random ( | |||
22 | import Numeric.GSL.Vector | 22 | import Numeric.GSL.Vector |
23 | import Data.Packed | 23 | import Data.Packed |
24 | import Numeric.Container | 24 | import Numeric.Container |
25 | import Data.Packed.Internal(constantD) | ||
26 | import Numeric.LinearAlgebra.Algorithms | 25 | import Numeric.LinearAlgebra.Algorithms |
27 | 26 | ||
28 | constant k v = constantD k v | ||
29 | 27 | ||
30 | -- | Obtains a matrix whose rows are pseudorandom samples from a multivariate | 28 | -- | Obtains a matrix whose rows are pseudorandom samples from a multivariate |
31 | -- Gaussian distribution. | 29 | -- Gaussian distribution. |
@@ -36,7 +34,7 @@ gaussianSample :: Int -- ^ seed | |||
36 | -> Matrix Double -- ^ result | 34 | -> Matrix Double -- ^ result |
37 | gaussianSample seed n med cov = m where | 35 | gaussianSample seed n med cov = m where |
38 | c = dim med | 36 | c = dim med |
39 | meds = constant 1 n `outer` med | 37 | meds = konst 1 n `outer` med |
40 | rs = reshape c $ randomVector seed Gaussian (c * n) | 38 | rs = reshape c $ randomVector seed Gaussian (c * n) |
41 | m = rs `mXm` cholSH cov `add` meds | 39 | m = rs `mXm` cholSH cov `add` meds |
42 | 40 | ||
@@ -52,7 +50,7 @@ uniformSample seed n rgs = m where | |||
52 | cs = zipWith subtract as bs | 50 | cs = zipWith subtract as bs |
53 | d = dim a | 51 | d = dim a |
54 | dat = toRows $ reshape n $ randomVector seed Uniform (n*d) | 52 | dat = toRows $ reshape n $ randomVector seed Uniform (n*d) |
55 | am = constant 1 n `outer` a | 53 | am = konst 1 n `outer` a |
56 | m = fromColumns (zipWith scale cs dat) `add` am | 54 | m = fromColumns (zipWith scale cs dat) `add` am |
57 | 55 | ||
58 | ------------ utilities ------------------------------- | 56 | ------------ utilities ------------------------------- |
@@ -62,7 +60,7 @@ meanCov :: Matrix Double -> (Vector Double, Matrix Double) | |||
62 | meanCov x = (med,cov) where | 60 | meanCov x = (med,cov) where |
63 | r = rows x | 61 | r = rows x |
64 | k = 1 / fromIntegral r | 62 | k = 1 / fromIntegral r |
65 | med = constant k r `vXm` x | 63 | med = konst k r `vXm` x |
66 | meds = constant 1 r `outer` med | 64 | meds = konst 1 r `outer` med |
67 | xc = x `sub` meds | 65 | xc = x `sub` meds |
68 | cov = flip scale (trans xc `mXm` xc) (recip (fromIntegral (r-1))) | 66 | cov = flip scale (trans xc `mXm` xc) (recip (fromIntegral (r-1))) |
diff --git a/lib/Numeric/Container.hs b/lib/Numeric/Container.hs index 44e2711..2c9c500 100644 --- a/lib/Numeric/Container.hs +++ b/lib/Numeric/Container.hs | |||
@@ -71,9 +71,11 @@ class (Element e) => Container c e where | |||
71 | -- | element by element division | 71 | -- | element by element division |
72 | divide :: c e -> c e -> c e | 72 | divide :: c e -> c e -> c e |
73 | equal :: c e -> c e -> Bool | 73 | equal :: c e -> c e -> Bool |
74 | 74 | -- | |
75 | -- | cannot implement instance Functor because of Element class constraint | 75 | -- | cannot implement instance Functor because of Element class constraint |
76 | cmap :: (Element a, Element b) => (a -> b) -> c a -> c b | 76 | cmap :: (Element a, Element b) => (a -> b) -> c a -> c b |
77 | -- | constant structure of given size | ||
78 | konst :: e -> IndexOf c -> c e | ||
77 | -- | 79 | -- |
78 | -- | indexing function | 80 | -- | indexing function |
79 | atIndex :: c e -> IndexOf c -> e | 81 | atIndex :: c e -> IndexOf c -> e |
@@ -107,8 +109,7 @@ instance Container Vector Float where | |||
107 | divide = vectorZipF Div | 109 | divide = vectorZipF Div |
108 | equal u v = dim u == dim v && maxElement (vectorMapF Abs (sub u v)) == 0.0 | 110 | equal u v = dim u == dim v && maxElement (vectorMapF Abs (sub u v)) == 0.0 |
109 | scalar x = fromList [x] | 111 | scalar x = fromList [x] |
110 | -- | 112 | konst = constantD |
111 | --instance Container Vector Float where | ||
112 | cmap = mapVector | 113 | cmap = mapVector |
113 | atIndex = (@>) | 114 | atIndex = (@>) |
114 | minIndex = round . toScalarF MinIdx | 115 | minIndex = round . toScalarF MinIdx |
@@ -128,8 +129,7 @@ instance Container Vector Double where | |||
128 | divide = vectorZipR Div | 129 | divide = vectorZipR Div |
129 | equal u v = dim u == dim v && maxElement (vectorMapR Abs (sub u v)) == 0.0 | 130 | equal u v = dim u == dim v && maxElement (vectorMapR Abs (sub u v)) == 0.0 |
130 | scalar x = fromList [x] | 131 | scalar x = fromList [x] |
131 | -- | 132 | konst = constantD |
132 | --instance Container Vector Double where | ||
133 | cmap = mapVector | 133 | cmap = mapVector |
134 | atIndex = (@>) | 134 | atIndex = (@>) |
135 | minIndex = round . toScalarR MinIdx | 135 | minIndex = round . toScalarR MinIdx |
@@ -149,8 +149,7 @@ instance Container Vector (Complex Double) where | |||
149 | divide = vectorZipC Div | 149 | divide = vectorZipC Div |
150 | equal u v = dim u == dim v && maxElement (mapVector magnitude (sub u v)) == 0.0 | 150 | equal u v = dim u == dim v && maxElement (mapVector magnitude (sub u v)) == 0.0 |
151 | scalar x = fromList [x] | 151 | scalar x = fromList [x] |
152 | -- | 152 | konst = constantD |
153 | --instance Container Vector (Complex Double) where | ||
154 | cmap = mapVector | 153 | cmap = mapVector |
155 | atIndex = (@>) | 154 | atIndex = (@>) |
156 | minIndex = minIndex . fst . fromComplex . (zipVectorWith (*) `ap` mapVector conjugate) | 155 | minIndex = minIndex . fst . fromComplex . (zipVectorWith (*) `ap` mapVector conjugate) |
@@ -170,8 +169,7 @@ instance Container Vector (Complex Float) where | |||
170 | divide = vectorZipQ Div | 169 | divide = vectorZipQ Div |
171 | equal u v = dim u == dim v && maxElement (mapVector magnitude (sub u v)) == 0.0 | 170 | equal u v = dim u == dim v && maxElement (mapVector magnitude (sub u v)) == 0.0 |
172 | scalar x = fromList [x] | 171 | scalar x = fromList [x] |
173 | -- | 172 | konst = constantD |
174 | --instance Container Vector (Complex Float) where | ||
175 | cmap = mapVector | 173 | cmap = mapVector |
176 | atIndex = (@>) | 174 | atIndex = (@>) |
177 | minIndex = minIndex . fst . fromComplex . (zipVectorWith (*) `ap` mapVector conjugate) | 175 | minIndex = minIndex . fst . fromComplex . (zipVectorWith (*) `ap` mapVector conjugate) |
@@ -193,8 +191,7 @@ instance (Container Vector a) => Container Matrix a where | |||
193 | divide = liftMatrix2 divide | 191 | divide = liftMatrix2 divide |
194 | equal a b = cols a == cols b && flatten a `equal` flatten b | 192 | equal a b = cols a == cols b && flatten a `equal` flatten b |
195 | scalar x = (1><1) [x] | 193 | scalar x = (1><1) [x] |
196 | -- | 194 | konst v (r,c) = reshape c (konst v (r*c)) |
197 | --instance (Container Vector a) => Container Matrix a where | ||
198 | cmap f = liftMatrix (mapVector f) | 195 | cmap f = liftMatrix (mapVector f) |
199 | atIndex = (@@>) | 196 | atIndex = (@@>) |
200 | minIndex m = let (r,c) = (rows m,cols m) | 197 | minIndex m = let (r,c) = (rows m,cols m) |
diff --git a/lib/Numeric/LinearAlgebra/Algorithms.hs b/lib/Numeric/LinearAlgebra/Algorithms.hs index 6e703fa..5bc9ca5 100644 --- a/lib/Numeric/LinearAlgebra/Algorithms.hs +++ b/lib/Numeric/LinearAlgebra/Algorithms.hs | |||
@@ -83,8 +83,6 @@ import Data.List(foldl1') | |||
83 | import Data.Array | 83 | import Data.Array |
84 | import Numeric.Container | 84 | import Numeric.Container |
85 | 85 | ||
86 | constant x = constantD x | ||
87 | |||
88 | -- | Auxiliary typeclass used to define generic computations for both real and complex matrices. | 86 | -- | Auxiliary typeclass used to define generic computations for both real and complex matrices. |
89 | class (Product t, Container Vector t, Container Matrix t) => Field t where | 87 | class (Product t, Container Vector t, Container Matrix t) => Field t where |
90 | svd' :: Matrix t -> (Matrix t, Vector Double, Matrix t) | 88 | svd' :: Matrix t -> (Matrix t, Vector Double, Matrix t) |
@@ -469,7 +467,7 @@ zh k v = fromList $ replicate (k-1) 0 ++ (1:drop k xs) | |||
469 | where xs = toList v | 467 | where xs = toList v |
470 | 468 | ||
471 | zt 0 v = v | 469 | zt 0 v = v |
472 | zt k v = join [subVector 0 (dim v - k) v, constant 0 k] | 470 | zt k v = join [subVector 0 (dim v - k) v, konst 0 k] |
473 | 471 | ||
474 | 472 | ||
475 | unpackQR :: (Field t) => (Matrix t, Vector t) -> (Matrix t, Matrix t) | 473 | unpackQR :: (Field t) => (Matrix t, Vector t) -> (Matrix t, Matrix t) |
@@ -623,10 +621,10 @@ luFact (l_u,perm) | r <= c = (l ,u ,p, s) | |||
623 | c = cols l_u | 621 | c = cols l_u |
624 | tu = triang r c 0 1 | 622 | tu = triang r c 0 1 |
625 | tl = triang r c 0 0 | 623 | tl = triang r c 0 0 |
626 | l = takeColumns r (l_u |*| tl) |+| diagRect (constant 1 r) r r | 624 | l = takeColumns r (l_u |*| tl) |+| diagRect (konst 1 r) r r |
627 | u = l_u |*| tu | 625 | u = l_u |*| tu |
628 | (p,s) = fixPerm r perm | 626 | (p,s) = fixPerm r perm |
629 | l' = (l_u |*| tl) |+| diagRect (constant 1 c) r c | 627 | l' = (l_u |*| tl) |+| diagRect (konst 1 c) r c |
630 | u' = takeRows c (l_u |*| tu) | 628 | u' = takeRows c (l_u |*| tu) |
631 | (|+|) = add | 629 | (|+|) = add |
632 | (|*|) = mul | 630 | (|*|) = mul |