summaryrefslogtreecommitdiff
path: root/lib/Numeric/LinearAlgebra/Tests
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2009-12-28 15:47:26 +0000
committerAlberto Ruiz <aruiz@um.es>2009-12-28 15:47:26 +0000
commitb2715e91d7aef5cee1b64b641b8f173167a7145a (patch)
treef97b82cfa435441f52153ccdfad5e1fa119f14dc /lib/Numeric/LinearAlgebra/Tests
parent107478b2288b0904159599be94089230c7cd3edf (diff)
additional svd functions
Diffstat (limited to 'lib/Numeric/LinearAlgebra/Tests')
-rw-r--r--lib/Numeric/LinearAlgebra/Tests/Instances.hs8
-rw-r--r--lib/Numeric/LinearAlgebra/Tests/Properties.hs78
2 files changed, 72 insertions, 14 deletions
diff --git a/lib/Numeric/LinearAlgebra/Tests/Instances.hs b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
index 9b18513..4995e39 100644
--- a/lib/Numeric/LinearAlgebra/Tests/Instances.hs
+++ b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
@@ -143,8 +143,8 @@ instance (Field a, Arbitrary a) => Arbitrary (WC a) where
143 r = rows m 143 r = rows m
144 c = cols m 144 c = cols m
145 n = min r c 145 n = min r c
146 sv <- replicateM n (choose (1,100)) 146 sv' <- replicateM n (choose (1,100))
147 let s = diagRect (fromList sv) r c 147 let s = diagRect (fromList sv') r c
148 return $ WC (u <> real s <> trans v) 148 return $ WC (u <> real s <> trans v)
149 149
150#if MIN_VERSION_QuickCheck(2,0,0) 150#if MIN_VERSION_QuickCheck(2,0,0)
@@ -160,8 +160,8 @@ instance (Field a, Arbitrary a) => Arbitrary (SqWC a) where
160 Sq m <- arbitrary 160 Sq m <- arbitrary
161 let (u,_,v) = svd m 161 let (u,_,v) = svd m
162 n = rows m 162 n = rows m
163 sv <- replicateM n (choose (1,100)) 163 sv' <- replicateM n (choose (1,100))
164 let s = diag (fromList sv) 164 let s = diag (fromList sv')
165 return $ SqWC (u <> real s <> trans v) 165 return $ SqWC (u <> real s <> trans v)
166 166
167#if MIN_VERSION_QuickCheck(2,0,0) 167#if MIN_VERSION_QuickCheck(2,0,0)
diff --git a/lib/Numeric/LinearAlgebra/Tests/Properties.hs b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
index d4c2770..d4dff34 100644
--- a/lib/Numeric/LinearAlgebra/Tests/Properties.hs
+++ b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
@@ -29,7 +29,8 @@ module Numeric.LinearAlgebra.Tests.Properties (
29 pinvProp, 29 pinvProp,
30 detProp, 30 detProp,
31 nullspaceProp, 31 nullspaceProp,
32 svdProp1, svdProp2, 32 svdProp1, svdProp1a, svdProp2, svdProp3, svdProp4,
33 svdProp5a, svdProp5b, svdProp6a, svdProp6b, svdProp7,
33 eigProp, eigSHProp, 34 eigProp, eigSHProp,
34 qrProp, 35 qrProp,
35 hessProp, 36 hessProp,
@@ -41,10 +42,12 @@ module Numeric.LinearAlgebra.Tests.Properties (
41) where 42) where
42 43
43import Numeric.LinearAlgebra 44import Numeric.LinearAlgebra
45import Numeric.LinearAlgebra.LAPACK
46import Debug.Trace
44#include "quickCheckCompat.h" 47#include "quickCheckCompat.h"
45-- import Debug.Trace
46 48
47-- debug x = trace (show x) x 49
50debug x = trace (show x) x
48 51
49-- relative error 52-- relative error
50dist :: (Normed t, Num t) => t -> t -> Double 53dist :: (Normed t, Num t) => t -> t -> Double
@@ -71,7 +74,10 @@ a :~n~: b = dist a b < 10^^(-n)
71 74
72square m = rows m == cols m 75square m = rows m == cols m
73 76
74unitary m = square m && m <> ctrans m |~| ident (rows m) 77-- orthonormal columns
78orthonormal m = ctrans m <> m |~| ident (cols m)
79
80unitary m = square m && orthonormal m
75 81
76hermitian m = square m && m |~| ctrans m 82hermitian m = square m && m |~| ctrans m
77 83
@@ -119,12 +125,64 @@ nullspaceProp m = null nl `trivial` (null nl || m <> n |~| zeros (r,c))
119 r = rows m 125 r = rows m
120 c = cols m - rank m 126 c = cols m - rank m
121 127
122svdProp1 m = u <> real d <> trans v |~| m 128------------------------------------------------------------------
123 && unitary u && unitary v 129
124 where (u,d,v) = full svd m 130-- fullSVD
125 131svdProp1 m = m |~| u <> real d <> trans v && unitary u && unitary v
126svdProp2 m = (m |~| 0) `trivial` ((m |~| 0) || u <> real (diag s) <> trans v |~| m) 132 where (u,d,v) = fullSVD m
127 where (u,s,v) = economy svd m 133
134svdProp1a svdfun m = m |~| u <> real d <> trans v && unitary u && unitary v where
135 (u,s,v) = svdfun m
136 d = diagRect s (rows m) (cols m)
137
138-- thinSVD
139svdProp2 thinSVDfun m = m |~| u <> diag (real s) <> trans v && orthonormal u && orthonormal v && dim s == min (rows m) (cols m)
140 where (u,s,v) = thinSVDfun m
141
142-- compactSVD
143svdProp3 m = (m |~| u <> real (diag s) <> trans v
144 && orthonormal u && orthonormal v)
145 where (u,s,v) = compactSVD m
146
147svdProp4 m' = m |~| u <> real (diag s) <> trans v
148 && orthonormal u && orthonormal v
149 && (dim s == r || r == 0 && dim s == 1)
150 where (u,s,v) = compactSVD m
151 m = m' <-> m'
152 r = rank m'
153
154svdProp5a m = and (map (s1|~|) [s2,s3,s4,s5,s6]) where
155 s1 = svR m
156 s2 = svRd m
157 (_,s3,_) = svdR m
158 (_,s4,_) = svdRd m
159 (_,s5,_) = thinSVDR m
160 (_,s6,_) = thinSVDRd m
161
162svdProp5b m = and (map (s1|~|) [s2,s3,s4,s5,s6]) where
163 s1 = svC m
164 s2 = svCd m
165 (_,s3,_) = svdC m
166 (_,s4,_) = svdCd m
167 (_,s5,_) = thinSVDC m
168 (_,s6,_) = thinSVDCd m
169
170svdProp6a m = s |~| s' && v |~| v' && s |~| s'' && u |~| u'
171 where (u,s,v) = svdR m
172 (s',v') = rightSVR m
173 (u',s'') = leftSVR m
174
175svdProp6b m = s |~| s' && v |~| v' && s |~| s'' && u |~| u'
176 where (u,s,v) = svdC m
177 (s',v') = rightSVC m
178 (u',s'') = leftSVC m
179
180svdProp7 m = s |~| s' && u |~| u' && v |~| v'
181 where (u,s,v) = svd m
182 (s',v') = rightSV m
183 (u',s'') = leftSV m
184
185------------------------------------------------------------------
128 186
129eigProp m = complex m <> v |~| v <> diag s 187eigProp m = complex m <> v |~| v <> diag s
130 where (s, v) = eig m 188 where (s, v) = eig m