diff options
Diffstat (limited to 'examples')
-rw-r--r-- | examples/tests.hs | 20 |
1 files changed, 20 insertions, 0 deletions
diff --git a/examples/tests.hs b/examples/tests.hs index f167b92..5af33ba 100644 --- a/examples/tests.hs +++ b/examples/tests.hs | |||
@@ -66,6 +66,8 @@ aproxL fun v1 v2 = sum (zipWith (\a b-> fun (a-b)) v1 v2) / fromIntegral (length | |||
66 | (|~|) = aprox abs | 66 | (|~|) = aprox abs |
67 | (|~~|) = aprox magnitude | 67 | (|~~|) = aprox magnitude |
68 | 68 | ||
69 | v1 ~~ v2 = reshape 1 v1 |~~| reshape 1 v2 | ||
70 | |||
69 | eps = 1E-8::Double | 71 | eps = 1E-8::Double |
70 | 72 | ||
71 | asFortran m = (rows m >|< cols m) $ toList (fdat m) | 73 | asFortran m = (rows m >|< cols m) $ toList (fdat m) |
@@ -116,6 +118,15 @@ instance (Num a, Field a, Arbitrary a) => Arbitrary (PairM a) where | |||
116 | --return $ PairM ((a><b) l1) ((b><c) l2) | 118 | --return $ PairM ((a><b) l1) ((b><c) l2) |
117 | coarbitrary = undefined | 119 | coarbitrary = undefined |
118 | 120 | ||
121 | data SqM a = SqM (Matrix a) deriving Show | ||
122 | instance (Field a, Arbitrary a) => Arbitrary (SqM a) where | ||
123 | arbitrary = do | ||
124 | n <- choose (1,10) | ||
125 | l <- vector (n*n) | ||
126 | return $ SqM $ (n><n) l | ||
127 | coarbitrary = undefined | ||
128 | |||
129 | |||
119 | type BaseType = Double | 130 | type BaseType = Double |
120 | 131 | ||
121 | 132 | ||
@@ -133,6 +144,14 @@ svdTestC fun prod m = u <> s' <> (trans v) |~~| m | |||
133 | (<>) = prod | 144 | (<>) = prod |
134 | s' = liftMatrix comp s | 145 | s' = liftMatrix comp s |
135 | 146 | ||
147 | eigTestC fun prod (SqM m) = (m <> v) |~~| (v <> diag s) | ||
148 | && takeDiag ((liftMatrix conj (trans v)) `mulC` v) ~~ constant (rows m) 1 | ||
149 | where (s,v) = fun m | ||
150 | (<>) = prod | ||
151 | |||
152 | takeDiag m = fromList [cdat m `at` (k*cols m+k) | k <- [0 .. min (rows m) (cols m) -1]] | ||
153 | |||
154 | |||
136 | comp v = toComplex (v,constant (dim v) 0) | 155 | comp v = toComplex (v,constant (dim v) 0) |
137 | 156 | ||
138 | main = do | 157 | main = do |
@@ -147,3 +166,4 @@ main = do | |||
147 | quickCheck (svdTestR svdR mulF) | 166 | quickCheck (svdTestR svdR mulF) |
148 | quickCheck (svdTestC svdC mulC) | 167 | quickCheck (svdTestC svdC mulC) |
149 | quickCheck (svdTestC svdC mulF) | 168 | quickCheck (svdTestC svdC mulF) |
169 | quickCheck (eigTestC eigC mulC) | ||