diff options
author | Maxim Koltsov <kolmax94@gmail.com> | 2018-11-13 15:39:55 +0300 |
---|---|---|
committer | Maxim Koltsov <kolmax94@gmail.com> | 2018-11-13 15:39:55 +0300 |
commit | cc737710b4878a387ea8090f9c2330b1e8d73f38 (patch) | |
tree | 02fc9ff241d06ac168e6a6cc19ecfd8e6ce8f812 /packages/tests/src/Numeric/LinearAlgebra/Tests | |
parent | acb57ec8dd3011534813bdbee84563f1a830f499 (diff) |
Fix geig for complex eigenvalues, add tests
eigG was incorrectly returning eigenvectors corresponding to complex
eigenvalues. This was discovered with tests for geig, which are also
added to the repo.
Diffstat (limited to 'packages/tests/src/Numeric/LinearAlgebra/Tests')
-rw-r--r-- | packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs | 21 | ||||
-rw-r--r-- | packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs | 7 |
2 files changed, 28 insertions, 0 deletions
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs index 59230e0..97cfd01 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs | |||
@@ -17,6 +17,7 @@ Arbitrary instances for vectors, matrices. | |||
17 | 17 | ||
18 | module Numeric.LinearAlgebra.Tests.Instances( | 18 | module Numeric.LinearAlgebra.Tests.Instances( |
19 | Sq(..), rSq,cSq, | 19 | Sq(..), rSq,cSq, |
20 | Sq2WC(..), rSq2WC,cSq2WC, | ||
20 | Rot(..), rRot,cRot, | 21 | Rot(..), rRot,cRot, |
21 | rHer,cHer, | 22 | rHer,cHer, |
22 | WC(..), rWC,cWC, | 23 | WC(..), rWC,cWC, |
@@ -105,6 +106,23 @@ instance (Element a, Arbitrary a) => Arbitrary (Sq a) where | |||
105 | 106 | ||
106 | shrink (Sq a) = [ Sq b | b <- shrink a ] | 107 | shrink (Sq a) = [ Sq b | b <- shrink a ] |
107 | 108 | ||
109 | -- a pair of square matrices | ||
110 | newtype (Sq2WC a) = Sq2WC (Matrix a, Matrix a) deriving Show | ||
111 | instance (ArbitraryField a, Numeric a) => Arbitrary (Sq2WC a) where | ||
112 | arbitrary = do | ||
113 | n <- chooseDim | ||
114 | l <- vector (n*n) | ||
115 | r <- vector (n*n) | ||
116 | l' <- makeWC $ (n><n) l | ||
117 | r' <- makeWC $ (n><n) r | ||
118 | return $ Sq2WC (l', r') | ||
119 | where | ||
120 | makeWC m = do | ||
121 | let (u,_,v) = svd m | ||
122 | n = rows m | ||
123 | sv' <- replicateM n (choose (1,100)) | ||
124 | let s = diag (fromList sv') | ||
125 | return $ u <> real s <> tr v | ||
108 | 126 | ||
109 | -- a unitary matrix | 127 | -- a unitary matrix |
110 | newtype (Rot a) = Rot (Matrix a) deriving Show | 128 | newtype (Rot a) = Rot (Matrix a) deriving Show |
@@ -204,6 +222,9 @@ cRot (Rot m) = m :: CM | |||
204 | rSq (Sq m) = m :: RM | 222 | rSq (Sq m) = m :: RM |
205 | cSq (Sq m) = m :: CM | 223 | cSq (Sq m) = m :: CM |
206 | 224 | ||
225 | rSq2WC (Sq2WC (a, b)) = (a, b) :: (RM, RM) | ||
226 | cSq2WC (Sq2WC (a, b)) = (a, b) :: (CM, CM) | ||
227 | |||
207 | rWC (WC m) = m :: RM | 228 | rWC (WC m) = m :: RM |
208 | cWC (WC m) = m :: CM | 229 | cWC (WC m) = m :: CM |
209 | 230 | ||
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs index 6cd3a9e..38aa977 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs | |||
@@ -36,6 +36,7 @@ module Numeric.LinearAlgebra.Tests.Properties ( | |||
36 | svdProp1, svdProp1a, svdProp1b, svdProp2, svdProp3, svdProp4, | 36 | svdProp1, svdProp1a, svdProp1b, svdProp2, svdProp3, svdProp4, |
37 | svdProp5a, svdProp5b, svdProp6a, svdProp6b, svdProp7, | 37 | svdProp5a, svdProp5b, svdProp6a, svdProp6b, svdProp7, |
38 | eigProp, eigSHProp, eigProp2, eigSHProp2, | 38 | eigProp, eigSHProp, eigProp2, eigSHProp2, |
39 | geigProp, | ||
39 | qrProp, rqProp, rqProp1, rqProp2, rqProp3, | 40 | qrProp, rqProp, rqProp1, rqProp2, rqProp3, |
40 | hessProp, | 41 | hessProp, |
41 | schurProp1, schurProp2, | 42 | schurProp1, schurProp2, |
@@ -237,6 +238,12 @@ eigProp2 m = fst (eig m) |~| eigenvalues m | |||
237 | 238 | ||
238 | eigSHProp2 m = fst (eigSH' m) |~| eigenvaluesSH' m | 239 | eigSHProp2 m = fst (eigSH' m) |~| eigenvaluesSH' m |
239 | 240 | ||
241 | geigProp a b = a' <> v <> diag betas' |~| b' <> v <> diag alphas | ||
242 | where (alphas, betas, v) = geig a b | ||
243 | betas' = complex betas | ||
244 | a' = complex a | ||
245 | b' = complex b | ||
246 | |||
240 | ------------------------------------------------------------------ | 247 | ------------------------------------------------------------------ |
241 | 248 | ||
242 | qrProp m = q <> r |~| m && unitary q && upperTriang r | 249 | qrProp m = q <> r |~| m && unitary q && upperTriang r |