summaryrefslogtreecommitdiff
path: root/lib/Numeric/LinearAlgebra/Tests/Properties.hs
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2008-02-23 19:35:51 +0000
committerAlberto Ruiz <aruiz@um.es>2008-02-23 19:35:51 +0000
commit500f5fca244dadab494655aa73d7183df1c87c50 (patch)
treee02abfcf4db24a538646c6f0982c58dabb3adc63 /lib/Numeric/LinearAlgebra/Tests/Properties.hs
parentda54e2f2c27f68c08f4db7551c57b2c1136dc778 (diff)
working on tests
Diffstat (limited to 'lib/Numeric/LinearAlgebra/Tests/Properties.hs')
-rw-r--r--lib/Numeric/LinearAlgebra/Tests/Properties.hs70
1 files changed, 69 insertions, 1 deletions
diff --git a/lib/Numeric/LinearAlgebra/Tests/Properties.hs b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
index 351615b..0317469 100644
--- a/lib/Numeric/LinearAlgebra/Tests/Properties.hs
+++ b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
@@ -19,6 +19,7 @@ where
19 19
20import Numeric.LinearAlgebra 20import Numeric.LinearAlgebra
21import Numeric.LinearAlgebra.Tests.Instances(Sq(..),Her(..),Rot(..)) 21import Numeric.LinearAlgebra.Tests.Instances(Sq(..),Her(..),Rot(..))
22import Test.QuickCheck
22 23
23-- relative error 24-- relative error
24dist :: (Normed t, Num t) => t -> t -> Double 25dist :: (Normed t, Num t) => t -> t -> Double
@@ -53,7 +54,74 @@ degenerate m = rank m < min (rows m) (cols m)
53 54
54wellCond m = rcond m > 1/100 55wellCond m = rcond m > 1/100
55 56
57positiveDefinite m = minimum (toList e) > 0
58 where (e,v) = eigSH m
59
60upperTriang m = rows m == 1 || down == z
61 where down = fromList $ concat $ zipWith drop [1..] (toLists (ctrans m))
62 z = constant 0 (dim down)
63
64upperHessenberg m = rows m < 3 || down == z
65 where down = fromList $ concat $ zipWith drop [2..] (toLists (ctrans m))
66 z = constant 0 (dim down)
67
68zeros (r,c) = reshape c (constant 0 (r*c))
69
70ones (r,c) = zeros (r,c) + 1
71
56----------------------------------------------------- 72-----------------------------------------------------
57 73
58luTest m = m |~| p <> l <> u && det p == s 74luProp m = m |~| p <> l <> u && det p == s
59 where (l,u,p,s) = lu m 75 where (l,u,p,s) = lu m
76
77invProp m = m <> inv m |~| ident (rows m)
78
79pinvProp m = m <> p <> m |~| m
80 && p <> m <> p |~| p
81 && hermitian (m<>p)
82 && hermitian (p<>m)
83 where p = pinv m
84
85detProp m = s d1 |~| s d2
86 where d1 = det m
87 d2 = det' m * det q
88 det' m = product $ toList $ takeDiag r
89 (q,r) = qr m
90 s x = fromList [x]
91
92nullspaceProp m = null nl `trivial` (null nl || m <> n |~| zeros (r,c))
93 where nl = nullspacePrec 1 m
94 n = fromColumns nl
95 r = rows m
96 c = cols m - rank m
97
98svdProp1 m = u <> real d <> trans v |~| m
99 && unitary u && unitary v
100 where (u,d,v) = full svd m
101
102svdProp2 m = (m |~| 0) `trivial` ((m |~| 0) || u <> real (diag s) <> trans v |~| m)
103 where (u,s,v) = economy svd m
104
105eigProp m = complex m <> v |~| v <> diag s
106 where (s, v) = eig m
107
108eigSHProp m = m <> v |~| v <> real (diag s)
109 && unitary v
110 && m |~| v <> real (diag s) <> ctrans v
111 where (s, v) = eigSH m
112
113qrProp m = q <> r |~| m && unitary q && upperTriang r
114 where (q,r) = qr m
115
116hessProp m = m |~| p <> h <> ctrans p && unitary p && upperHessenberg h
117 where (p,h) = hess m
118
119schurProp1 m = m |~| u <> s <> ctrans u && unitary u && upperTriang s
120 where (u,s) = schur m
121
122schurProp2 m = m |~| u <> s <> ctrans u && unitary u && upperHessenberg s -- fixme
123 where (u,s) = schur m
124
125cholProp m = m |~| ctrans c <> c && upperTriang c
126 where c = chol m
127 pos = positiveDefinite m