diff options
Diffstat (limited to 'examples')
-rw-r--r-- | examples/oldtests.hs | 20 | ||||
-rw-r--r-- | examples/tests.hs | 17 |
2 files changed, 19 insertions, 18 deletions
diff --git a/examples/oldtests.hs b/examples/oldtests.hs index b01675f..f60f4e2 100644 --- a/examples/oldtests.hs +++ b/examples/oldtests.hs | |||
@@ -5,14 +5,14 @@ import System.Random(randomRs,mkStdGen) | |||
5 | realMatrix = fromLists :: [[Double]] -> Matrix Double | 5 | realMatrix = fromLists :: [[Double]] -> Matrix Double |
6 | realVector = fromList :: [Double] -> Vector Double | 6 | realVector = fromList :: [Double] -> Vector Double |
7 | 7 | ||
8 | toComplexM = uncurry $ liftMatrix2 (curry toComplex) | 8 | |
9 | 9 | ||
10 | infixl 2 =~= | 10 | infixl 2 =~= |
11 | a =~= b = pnorm 1 (flatten (a - b)) < 1E-6 | 11 | a =~= b = pnorm 1 (flatten (a - b)) < 1E-6 |
12 | 12 | ||
13 | randomMatrix seed (n,m) = reshape m $ realVector $ take (n*m) $ randomRs (-100,100) $ mkStdGen seed | 13 | randomMatrix seed (n,m) = reshape m $ realVector $ take (n*m) $ randomRs (-100,100) $ mkStdGen seed |
14 | 14 | ||
15 | randomMatrixC seed (n,m) = toComplexM (randomMatrix seed (n,m), randomMatrix (seed+1) (n,m)) | 15 | randomMatrixC seed (n,m) = toComplex (randomMatrix seed (n,m), randomMatrix (seed+1) (n,m)) |
16 | 16 | ||
17 | besselTest = do | 17 | besselTest = do |
18 | let (r,e) = bessel_J0_e 5.0 | 18 | let (r,e) = bessel_J0_e 5.0 |
@@ -31,7 +31,7 @@ ms = realMatrix [[1,2,3] | |||
31 | 31 | ||
32 | ms' = randomMatrix 27 (50,100) | 32 | ms' = randomMatrix 27 (50,100) |
33 | 33 | ||
34 | ms'' = toComplexM (randomMatrix 100 (50,100),randomMatrix 101 (50,100)) | 34 | ms'' = toComplex (randomMatrix 100 (50,100),randomMatrix 101 (50,100)) |
35 | 35 | ||
36 | fullsvdTest method mat msg = do | 36 | fullsvdTest method mat msg = do |
37 | let (u,s,vt) = method mat | 37 | let (u,s,vt) = method mat |
@@ -43,7 +43,7 @@ full_svd_Rd = svdRdd | |||
43 | 43 | ||
44 | -------------------------------------------------------------------- | 44 | -------------------------------------------------------------------- |
45 | 45 | ||
46 | mcu = toComplexM (randomMatrix 33 (20,20),randomMatrix 34 (20,20)) | 46 | mcu = toComplex (randomMatrix 33 (20,20),randomMatrix 34 (20,20)) |
47 | 47 | ||
48 | mcur = randomMatrix 35 (40,40) | 48 | mcur = randomMatrix 35 (40,40) |
49 | 49 | ||
@@ -53,7 +53,7 @@ eigTest method m msg = do | |||
53 | assertBool msg $ m <> v =~= v <> diag s | 53 | assertBool msg $ m <> v =~= v <> diag s |
54 | 54 | ||
55 | bigmat = m + trans m where m = randomMatrix 18 (1000,1000) | 55 | bigmat = m + trans m where m = randomMatrix 18 (1000,1000) |
56 | bigmatc = mc + conjTrans mc where mc = toComplexM(m,m) | 56 | bigmatc = mc + conjTrans mc where mc = toComplex(m,m) |
57 | m = randomMatrix 19 (1000,1000) | 57 | m = randomMatrix 19 (1000,1000) |
58 | 58 | ||
59 | -------------------------------------------------------------------- | 59 | -------------------------------------------------------------------- |
@@ -62,22 +62,22 @@ invTest msg m = do | |||
62 | assertBool msg $ m <> inv m =~= ident (rows m) | 62 | assertBool msg $ m <> inv m =~= ident (rows m) |
63 | 63 | ||
64 | invComplexTest msg m = do | 64 | invComplexTest msg m = do |
65 | assertBool msg $ m <> invC m =~= ident (rows m) | 65 | assertBool msg $ m <> invC m =~= identC (rows m) |
66 | 66 | ||
67 | invC m = linearSolveC m (ident (rows m)) | 67 | invC m = linearSolveC m (identC (rows m)) |
68 | 68 | ||
69 | --identC n = toComplexM(ident n, (0::Double) <>ident n) | 69 | identC = comp . ident |
70 | 70 | ||
71 | -------------------------------------------------------------------- | 71 | -------------------------------------------------------------------- |
72 | 72 | ||
73 | pinvTest f msg m = do | 73 | pinvTest f msg m = do |
74 | assertBool msg $ m <> f m <> m =~= m | 74 | assertBool msg $ m <> f m <> m =~= m |
75 | 75 | ||
76 | pinvC m = linearSolveLSC m (ident (rows m)) | 76 | pinvC m = linearSolveLSC m (identC (rows m)) |
77 | 77 | ||
78 | pinvSVDR m = linearSolveSVDR Nothing m (ident (rows m)) | 78 | pinvSVDR m = linearSolveSVDR Nothing m (ident (rows m)) |
79 | 79 | ||
80 | pinvSVDC m = linearSolveSVDC Nothing m (ident (rows m)) | 80 | pinvSVDC m = linearSolveSVDC Nothing m (identC (rows m)) |
81 | 81 | ||
82 | -------------------------------------------------------------------- | 82 | -------------------------------------------------------------------- |
83 | 83 | ||
diff --git a/examples/tests.hs b/examples/tests.hs index 0a09ced..2f3b3d8 100644 --- a/examples/tests.hs +++ b/examples/tests.hs | |||
@@ -6,10 +6,9 @@ | |||
6 | 6 | ||
7 | ----------------------------------------------------------------------------- | 7 | ----------------------------------------------------------------------------- |
8 | 8 | ||
9 | import Data.Packed.Internal | 9 | import Data.Packed.Internal((>|<), fdat, cdat, multiply', multiplyG, MatrixOrder(..)) |
10 | import Data.Packed.Vector | 10 | import Data.Packed.Vector |
11 | import Data.Packed.Matrix | 11 | import Data.Packed.Matrix |
12 | import Data.Packed.Internal.Matrix | ||
13 | import GSL.Vector | 12 | import GSL.Vector |
14 | import GSL.Integration | 13 | import GSL.Integration |
15 | import GSL.Differentiation | 14 | import GSL.Differentiation |
@@ -95,6 +94,8 @@ asC m = (rows m >< cols m) $ toList (cdat m) | |||
95 | mulC a b = multiply' RowMajor a b | 94 | mulC a b = multiply' RowMajor a b |
96 | mulF a b = multiply' ColumnMajor a b | 95 | mulF a b = multiply' ColumnMajor a b |
97 | 96 | ||
97 | identC = comp . ident | ||
98 | |||
98 | infixl 7 <> | 99 | infixl 7 <> |
99 | a <> b = mulF a b | 100 | a <> b = mulF a b |
100 | 101 | ||
@@ -198,15 +199,15 @@ svdTestR fun m = u <> s <> trans v |~| m | |||
198 | 199 | ||
199 | 200 | ||
200 | svdTestC m = u <> s' <> (trans v) |~| m | 201 | svdTestC m = u <> s' <> (trans v) |~| m |
201 | && u <> conjTrans u |~| ident (rows m) | 202 | && u <> conjTrans u |~| identC (rows m) |
202 | && v <> conjTrans v |~| ident (cols m) | 203 | && v <> conjTrans v |~| identC (cols m) |
203 | where (u,s,v) = svdC m | 204 | where (u,s,v) = svdC m |
204 | s' = liftMatrix comp s | 205 | s' = liftMatrix comp s |
205 | 206 | ||
206 | --svdg' m = (u,s',v) where | 207 | --svdg' m = (u,s',v) where |
207 | 208 | ||
208 | eigTestC (SqM m) = (m <> v) |~| (v <> diag s) | 209 | eigTestC (SqM m) = (m <> v) |~| (v <> diag s) |
209 | && takeDiag (conjTrans v <> v) |~| constant 1 (rows m) --normalized | 210 | && takeDiag (conjTrans v <> v) |~| comp (constant 1 (rows m)) --normalized |
210 | where (s,v) = eigC m | 211 | where (s,v) = eigC m |
211 | 212 | ||
212 | eigTestR (SqM m) = (liftMatrix comp m <> v) |~| (v <> diag s) | 213 | eigTestR (SqM m) = (liftMatrix comp m <> v) |~| (v <> diag s) |
@@ -218,7 +219,7 @@ eigTestS (Sym m) = (m <> v) |~| (v <> diag s) | |||
218 | where (s,v) = eigS m | 219 | where (s,v) = eigS m |
219 | 220 | ||
220 | eigTestH (Her m) = (m <> v) |~| (v <> diag (comp s)) | 221 | eigTestH (Her m) = (m <> v) |~| (v <> diag (comp s)) |
221 | && v <> conjTrans v |~| ident (cols m) | 222 | && v <> conjTrans v |~| identC (cols m) |
222 | where (s,v) = eigH m | 223 | where (s,v) = eigH m |
223 | 224 | ||
224 | linearSolveSQTest fun singu (PairSM a b) = singu a || (a <> fun a b) |~| b | 225 | linearSolveSQTest fun singu (PairSM a b) = singu a || (a <> fun a b) |~| b |
@@ -248,11 +249,11 @@ identC n = toComplex(ident n, (0::Double) <>ident n) | |||
248 | pinvTest f m = (m <> f m <> m) |~| m | 249 | pinvTest f m = (m <> f m <> m) |~| m |
249 | 250 | ||
250 | pinvR m = linearSolveLSR m (ident (rows m)) | 251 | pinvR m = linearSolveLSR m (ident (rows m)) |
251 | pinvC m = linearSolveLSC m (ident (rows m)) | 252 | pinvC m = linearSolveLSC m (identC (rows m)) |
252 | 253 | ||
253 | pinvSVDR m = linearSolveSVDR Nothing m (ident (rows m)) | 254 | pinvSVDR m = linearSolveSVDR Nothing m (ident (rows m)) |
254 | 255 | ||
255 | pinvSVDC m = linearSolveSVDC Nothing m (ident (rows m)) | 256 | pinvSVDC m = linearSolveSVDC Nothing m (identC (rows m)) |
256 | 257 | ||
257 | -------------------------------------------------------------------- | 258 | -------------------------------------------------------------------- |
258 | 259 | ||