diff options
Diffstat (limited to 'packages')
-rw-r--r-- | packages/tests/hmatrix-tests.cabal | 6 | ||||
-rw-r--r-- | packages/tests/src/Numeric/GSL/Tests.hs | 2 | ||||
-rw-r--r-- | packages/tests/src/Numeric/LinearAlgebra/Tests.hs | 191 | ||||
-rw-r--r-- | packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs | 19 | ||||
-rw-r--r-- | packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs | 147 |
5 files changed, 184 insertions, 181 deletions
diff --git a/packages/tests/hmatrix-tests.cabal b/packages/tests/hmatrix-tests.cabal index 0514843..de796e8 100644 --- a/packages/tests/hmatrix-tests.cabal +++ b/packages/tests/hmatrix-tests.cabal | |||
@@ -1,5 +1,5 @@ | |||
1 | Name: hmatrix-tests | 1 | Name: hmatrix-tests |
2 | Version: 0.4.1.0 | 2 | Version: 0.5.0.0 |
3 | License: BSD3 | 3 | License: BSD3 |
4 | License-file: LICENSE | 4 | License-file: LICENSE |
5 | Author: Alberto Ruiz | 5 | Author: Alberto Ruiz |
@@ -28,9 +28,9 @@ library | |||
28 | 28 | ||
29 | Build-Depends: base >= 4 && < 5, | 29 | Build-Depends: base >= 4 && < 5, |
30 | QuickCheck >= 2, HUnit, random, | 30 | QuickCheck >= 2, HUnit, random, |
31 | hmatrix >= 0.16 | 31 | hmatrix >= 0.17 |
32 | if flag(gsl) | 32 | if flag(gsl) |
33 | Build-Depends: hmatrix-gsl >= 0.16 | 33 | Build-Depends: hmatrix-gsl >= 0.17 |
34 | 34 | ||
35 | hs-source-dirs: src | 35 | hs-source-dirs: src |
36 | 36 | ||
diff --git a/packages/tests/src/Numeric/GSL/Tests.hs b/packages/tests/src/Numeric/GSL/Tests.hs index 9dff6f5..2e225b6 100644 --- a/packages/tests/src/Numeric/GSL/Tests.hs +++ b/packages/tests/src/Numeric/GSL/Tests.hs | |||
@@ -19,7 +19,7 @@ import System.Exit (exitFailure) | |||
19 | 19 | ||
20 | import Test.HUnit (runTestTT, failures, Test(..), errors) | 20 | import Test.HUnit (runTestTT, failures, Test(..), errors) |
21 | 21 | ||
22 | import Numeric.LinearAlgebra | 22 | import Numeric.LinearAlgebra.HMatrix |
23 | import Numeric.GSL | 23 | import Numeric.GSL |
24 | import Numeric.LinearAlgebra.Tests (qCheck, utest) | 24 | import Numeric.LinearAlgebra.Tests (qCheck, utest) |
25 | import Numeric.LinearAlgebra.Tests.Properties ((|~|), (~~)) | 25 | import Numeric.LinearAlgebra.Tests.Properties ((|~|), (~~)) |
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs index 713af79..14d02e4 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs | |||
@@ -1,9 +1,9 @@ | |||
1 | {-# LANGUAGE CPP #-} | 1 | {-# LANGUAGE CPP #-} |
2 | {-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-incomplete-patterns #-} | 2 | {-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-incomplete-patterns #-} |
3 | {-# LANGUAGE DataKinds #-} | 3 | {-# LANGUAGE DataKinds #-} |
4 | {-# LANGUAGE TypeFamilies #-} | ||
5 | {-# LANGUAGE FlexibleContexts #-} | 4 | {-# LANGUAGE FlexibleContexts #-} |
6 | {-# LANGUAGE RankNTypes #-} | 5 | {-# LANGUAGE GADTs #-} |
6 | |||
7 | 7 | ||
8 | ----------------------------------------------------------------------------- | 8 | ----------------------------------------------------------------------------- |
9 | {- | | 9 | {- | |
@@ -28,12 +28,10 @@ module Numeric.LinearAlgebra.Tests( | |||
28 | --, runBigTests | 28 | --, runBigTests |
29 | ) where | 29 | ) where |
30 | 30 | ||
31 | import Numeric.LinearAlgebra | 31 | import Numeric.LinearAlgebra.HMatrix |
32 | import Numeric.LinearAlgebra.HMatrix hiding ((<>),linearSolve) | 32 | import Numeric.LinearAlgebra.Devel hiding (vec) |
33 | import Numeric.LinearAlgebra.Util hiding (ones) | ||
33 | import Numeric.LinearAlgebra.Static(L) | 34 | import Numeric.LinearAlgebra.Static(L) |
34 | import Numeric.LinearAlgebra.Util(col,row) | ||
35 | import Data.Packed | ||
36 | import Numeric.LinearAlgebra.LAPACK | ||
37 | import Numeric.LinearAlgebra.Tests.Instances | 35 | import Numeric.LinearAlgebra.Tests.Instances |
38 | import Numeric.LinearAlgebra.Tests.Properties | 36 | import Numeric.LinearAlgebra.Tests.Properties |
39 | import Test.HUnit hiding ((~:),test,Testable,State) | 37 | import Test.HUnit hiding ((~:),test,Testable,State) |
@@ -44,20 +42,16 @@ import qualified Prelude | |||
44 | import System.CPUTime | 42 | import System.CPUTime |
45 | import System.Exit | 43 | import System.Exit |
46 | import Text.Printf | 44 | import Text.Printf |
47 | import Data.Packed.Development(unsafeFromForeignPtr,unsafeToForeignPtr) | 45 | import Numeric.LinearAlgebra.Devel(unsafeFromForeignPtr,unsafeToForeignPtr) |
48 | import Control.Arrow((***)) | 46 | import Control.Arrow((***)) |
49 | import Debug.Trace | 47 | import Debug.Trace |
50 | import Control.Monad(when) | 48 | import Control.Monad(when) |
51 | import Numeric.LinearAlgebra.Util hiding (ones,row,col) | ||
52 | import Control.Applicative | 49 | import Control.Applicative |
53 | import Control.Monad(ap) | 50 | import Control.Monad(ap) |
54 | 51 | ||
55 | import Data.Packed.ST | ||
56 | |||
57 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector | 52 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector |
58 | ,sized,classify,Testable,Property | 53 | ,sized,classify,Testable,Property |
59 | ,quickCheckWithResult,maxSize,stdArgs,shrink) | 54 | ,quickCheckWithResult,maxSize,stdArgs,shrink) |
60 | import qualified Test.QuickCheck as T | ||
61 | 55 | ||
62 | import Test.QuickCheck.Test(isSuccess) | 56 | import Test.QuickCheck.Test(isSuccess) |
63 | 57 | ||
@@ -89,7 +83,7 @@ detTest1 = det m == 26 | |||
89 | mc = (3><3) | 83 | mc = (3><3) |
90 | [ 1, 2, 3 | 84 | [ 1, 2, 3 |
91 | , 4, 5, 7 | 85 | , 4, 5, 7 |
92 | , 2, 8, i | 86 | , 2, 8, iC |
93 | ] | 87 | ] |
94 | 88 | ||
95 | detTest2 = inv1 |~| inv2 && [det1] ~~ [det2] | 89 | detTest2 = inv1 |~| inv2 && [det1] ~~ [det2] |
@@ -140,7 +134,7 @@ randomTestGaussian = c :~1~: snd (meanCov dat) where | |||
140 | 2,4,0, | 134 | 2,4,0, |
141 | -2,2,1] | 135 | -2,2,1] |
142 | m = 3 |> [1,2,3] | 136 | m = 3 |> [1,2,3] |
143 | c = a <> trans a | 137 | c = a <> tr a |
144 | dat = gaussianSample 7 (10^6) m c | 138 | dat = gaussianSample 7 (10^6) m c |
145 | 139 | ||
146 | randomTestUniform = c :~1~: snd (meanCov dat) where | 140 | randomTestUniform = c :~1~: snd (meanCov dat) where |
@@ -174,51 +168,51 @@ offsetTest = y == y' where | |||
174 | 168 | ||
175 | normsVTest = TestList [ | 169 | normsVTest = TestList [ |
176 | utest "normv2CD" $ norm2PropC v | 170 | utest "normv2CD" $ norm2PropC v |
177 | , utest "normv2CF" $ norm2PropC (single v) | 171 | -- , utest "normv2CF" $ norm2PropC (single v) |
178 | #ifndef NONORMVTEST | 172 | #ifndef NONORMVTEST |
179 | , utest "normv2D" $ norm2PropR x | 173 | , utest "normv2D" $ norm2PropR x |
180 | , utest "normv2F" $ norm2PropR (single x) | 174 | -- , utest "normv2F" $ norm2PropR (single x) |
181 | #endif | 175 | #endif |
182 | , utest "normv1CD" $ norm1 v == 8 | 176 | , utest "normv1CD" $ norm_1 v == 8 |
183 | , utest "normv1CF" $ norm1 (single v) == 8 | 177 | -- , utest "normv1CF" $ norm_1 (single v) == 8 |
184 | , utest "normv1D" $ norm1 x == 6 | 178 | , utest "normv1D" $ norm_1 x == 6 |
185 | , utest "normv1F" $ norm1 (single x) == 6 | 179 | -- , utest "normv1F" $ norm_1 (single x) == 6 |
186 | 180 | ||
187 | , utest "normvInfCD" $ normInf v == 5 | 181 | , utest "normvInfCD" $ norm_Inf v == 5 |
188 | , utest "normvInfCF" $ normInf (single v) == 5 | 182 | -- , utest "normvInfCF" $ norm_Inf (single v) == 5 |
189 | , utest "normvInfD" $ normInf x == 3 | 183 | , utest "normvInfD" $ norm_Inf x == 3 |
190 | , utest "normvInfF" $ normInf (single x) == 3 | 184 | -- , utest "normvInfF" $ norm_Inf (single x) == 3 |
191 | 185 | ||
192 | ] where v = fromList [1,-2,3:+4] :: Vector (Complex Double) | 186 | ] where v = fromList [1,-2,3:+4] :: Vector (Complex Double) |
193 | x = fromList [1,2,-3] :: Vector Double | 187 | x = fromList [1,2,-3] :: Vector Double |
194 | #ifndef NONORMVTEST | 188 | #ifndef NONORMVTEST |
195 | norm2PropR a = norm2 a =~= sqrt (udot a a) | 189 | norm2PropR a = norm_2 a =~= sqrt (udot a a) |
196 | #endif | 190 | #endif |
197 | norm2PropC a = norm2 a =~= realPart (sqrt (a <.> a)) | 191 | norm2PropC a = norm_2 a =~= realPart (sqrt (a `dot` a)) |
198 | a =~= b = fromList [a] |~| fromList [b] | 192 | a =~= b = fromList [a] |~| fromList [b] |
199 | 193 | ||
200 | normsMTest = TestList [ | 194 | normsMTest = TestList [ |
201 | utest "norm2mCD" $ pnorm PNorm2 v =~= 8.86164970498005 | 195 | utest "norm2mCD" $ norm_2 v =~= 8.86164970498005 |
202 | , utest "norm2mCF" $ pnorm PNorm2 (single v) =~= 8.86164970498005 | 196 | -- , utest "norm2mCF" $ norm_2 (single v) =~= 8.86164970498005 |
203 | , utest "norm2mD" $ pnorm PNorm2 x =~= 5.96667765076216 | 197 | , utest "norm2mD" $ norm_2 x =~= 5.96667765076216 |
204 | , utest "norm2mF" $ pnorm PNorm2 (single x) =~= 5.96667765076216 | 198 | -- , utest "norm2mF" $ norm_2 (single x) =~= 5.96667765076216 |
205 | 199 | ||
206 | , utest "norm1mCD" $ pnorm PNorm1 v == 9 | 200 | , utest "norm1mCD" $ norm_1 v == 9 |
207 | , utest "norm1mCF" $ pnorm PNorm1 (single v) == 9 | 201 | -- , utest "norm1mCF" $ norm_1 (single v) == 9 |
208 | , utest "norm1mD" $ pnorm PNorm1 x == 7 | 202 | , utest "norm1mD" $ norm_1 x == 7 |
209 | , utest "norm1mF" $ pnorm PNorm1 (single x) == 7 | 203 | -- , utest "norm1mF" $ norm_1 (single x) == 7 |
210 | 204 | ||
211 | , utest "normmInfCD" $ pnorm Infinity v == 12 | 205 | , utest "normmInfCD" $ norm_Inf v == 12 |
212 | , utest "normmInfCF" $ pnorm Infinity (single v) == 12 | 206 | -- , utest "normmInfCF" $ norm_Inf (single v) == 12 |
213 | , utest "normmInfD" $ pnorm Infinity x == 8 | 207 | , utest "normmInfD" $ norm_Inf x == 8 |
214 | , utest "normmInfF" $ pnorm Infinity (single x) == 8 | 208 | -- , utest "normmInfF" $ norm_Inf (single x) == 8 |
215 | 209 | ||
216 | , utest "normmFroCD" $ pnorm Frobenius v =~= 8.88819441731559 | 210 | , utest "normmFroCD" $ norm_Frob v =~= 8.88819441731559 |
217 | , utest "normmFroCF" $ pnorm Frobenius (single v) =~~= 8.88819441731559 | 211 | -- , utest "normmFroCF" $ norm_Frob (single v) =~~= 8.88819441731559 |
218 | , utest "normmFroD" $ pnorm Frobenius x =~= 6.24499799839840 | 212 | , utest "normmFroD" $ norm_Frob x =~= 6.24499799839840 |
219 | , utest "normmFroF" $ pnorm Frobenius (single x) =~~= 6.24499799839840 | 213 | -- , utest "normmFroF" $ norm_Frob (single x) =~~= 6.24499799839840 |
220 | 214 | ||
221 | ] where v = (2><2) [1,-2*i,3:+4,7] :: Matrix (Complex Double) | 215 | ] where v = (2><2) [1,-2*iC,3:+4,7] :: Matrix (Complex Double) |
222 | x = (2><2) [1,2,-3,5] :: Matrix Double | 216 | x = (2><2) [1,2,-3,5] :: Matrix Double |
223 | a =~= b = fromList [a] :~10~: fromList [b] | 217 | a =~= b = fromList [a] :~10~: fromList [b] |
224 | a =~~= b = fromList [a] :~5~: fromList [b] | 218 | a =~~= b = fromList [a] :~5~: fromList [b] |
@@ -236,7 +230,7 @@ sumprodTest = TestList [ | |||
236 | , utest "prodD" $ prodProp v | 230 | , utest "prodD" $ prodProp v |
237 | , utest "prodF" $ prodProp (single v) | 231 | , utest "prodF" $ prodProp (single v) |
238 | ] where v = fromList [1,2,3] :: Vector Double | 232 | ] where v = fromList [1,2,3] :: Vector Double |
239 | z = fromList [1,2-i,3+i] | 233 | z = fromList [1,2-iC,3+iC] |
240 | prodProp x = prodElements x == product (toList x) | 234 | prodProp x = prodElements x == product (toList x) |
241 | 235 | ||
242 | --------------------------------------------------------------------- | 236 | --------------------------------------------------------------------- |
@@ -250,7 +244,7 @@ chainTest = utest "chain" $ foldl1' (<>) ms |~| optimiseMult ms where | |||
250 | 244 | ||
251 | --------------------------------------------------------------------- | 245 | --------------------------------------------------------------------- |
252 | 246 | ||
253 | conjuTest m = mapVector conjugate (flatten (trans m)) == flatten (ctrans m) | 247 | conjuTest m = cmap conjugate (flatten (conj (tr m))) == flatten (tr m) |
254 | 248 | ||
255 | --------------------------------------------------------------------- | 249 | --------------------------------------------------------------------- |
256 | 250 | ||
@@ -306,7 +300,7 @@ lift_maybe m = MaybeT $ do | |||
306 | 300 | ||
307 | -- apply a test to successive elements of a vector, evaluates to true iff test passes for all pairs | 301 | -- apply a test to successive elements of a vector, evaluates to true iff test passes for all pairs |
308 | --successive_ :: Storable a => (a -> a -> Bool) -> Vector a -> Bool | 302 | --successive_ :: Storable a => (a -> a -> Bool) -> Vector a -> Bool |
309 | successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ stp (subVector 1 (dim v - 1) v))) (v @> 0) | 303 | successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ stp (subVector 1 (size v - 1) v))) (v ! 0) |
310 | where stp e = do | 304 | where stp e = do |
311 | ep <- lift_maybe $ state_get | 305 | ep <- lift_maybe $ state_get |
312 | if t e ep | 306 | if t e ep |
@@ -315,7 +309,7 @@ successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ s | |||
315 | 309 | ||
316 | -- operate on successive elements of a vector and return the resulting vector, whose length 1 less than that of the input | 310 | -- operate on successive elements of a vector and return the resulting vector, whose length 1 less than that of the input |
317 | --successive :: (Storable a, Storable b) => (a -> a -> b) -> Vector a -> Vector b | 311 | --successive :: (Storable a, Storable b) => (a -> a -> b) -> Vector a -> Vector b |
318 | successive f v = evalState (mapVectorM stp (subVector 1 (dim v - 1) v)) (v @> 0) | 312 | successive f v = evalState (mapVectorM stp (subVector 1 (size v - 1) v)) (v ! 0) |
319 | where stp e = do | 313 | where stp e = do |
320 | ep <- state_get | 314 | ep <- state_get |
321 | state_put e | 315 | state_put e |
@@ -384,12 +378,12 @@ kroneckerTest = utest "kronecker" ok | |||
384 | x = (4><2) [3,5..] | 378 | x = (4><2) [3,5..] |
385 | b = (2><5) [0,5..] | 379 | b = (2><5) [0,5..] |
386 | v1 = vec (a <> x <> b) | 380 | v1 = vec (a <> x <> b) |
387 | v2 = (trans b `kronecker` a) <> vec x | 381 | v2 = (tr b `kronecker` a) #> vec x |
388 | s = trans b <> b | 382 | s = tr b <> b |
389 | v3 = vec s | 383 | v3 = vec s |
390 | v4 = (dup 5 :: Matrix Double) <> vech s | 384 | v4 = (dup 5 :: Matrix Double) #> vech s |
391 | ok = v1 == v2 && v3 == v4 | 385 | ok = v1 == v2 && v3 == v4 |
392 | && vtrans 1 a == trans a | 386 | && vtrans 1 a == tr a |
393 | && vtrans (rows a) a == asColumn (vec a) | 387 | && vtrans (rows a) a == asColumn (vec a) |
394 | 388 | ||
395 | -------------------------------------------------------------------------------- | 389 | -------------------------------------------------------------------------------- |
@@ -419,8 +413,7 @@ indexProp g f x = a1 == g a2 && a2 == a3 && b1 == g b2 && b2 == b3 | |||
419 | runTests :: Int -- ^ maximum dimension | 413 | runTests :: Int -- ^ maximum dimension |
420 | -> IO () | 414 | -> IO () |
421 | runTests n = do | 415 | runTests n = do |
422 | let test :: forall t . T.Testable t => t -> IO () | 416 | let test p = qCheck n p |
423 | test p = qCheck n p | ||
424 | putStrLn "------ index" | 417 | putStrLn "------ index" |
425 | test( \m -> indexProp id flatten (single (m :: RM)) ) | 418 | test( \m -> indexProp id flatten (single (m :: RM)) ) |
426 | test( \v -> indexProp id id (single (v :: Vector Double)) ) | 419 | test( \v -> indexProp id id (single (v :: Vector Double)) ) |
@@ -435,11 +428,11 @@ runTests n = do | |||
435 | test (multProp1 10 . cConsist) | 428 | test (multProp1 10 . cConsist) |
436 | test (multProp2 10 . rConsist) | 429 | test (multProp2 10 . rConsist) |
437 | test (multProp2 10 . cConsist) | 430 | test (multProp2 10 . cConsist) |
438 | putStrLn "------ mult Float" | 431 | -- putStrLn "------ mult Float" |
439 | test (multProp1 6 . (single *** single) . rConsist) | 432 | -- test (multProp1 6 . (single *** single) . rConsist) |
440 | test (multProp1 6 . (single *** single) . cConsist) | 433 | -- test (multProp1 6 . (single *** single) . cConsist) |
441 | test (multProp2 6 . (single *** single) . rConsist) | 434 | -- test (multProp2 6 . (single *** single) . rConsist) |
442 | test (multProp2 6 . (single *** single) . cConsist) | 435 | -- test (multProp2 6 . (single *** single) . cConsist) |
443 | putStrLn "------ sub-trans" | 436 | putStrLn "------ sub-trans" |
444 | test (subProp . rM) | 437 | test (subProp . rM) |
445 | test (subProp . cM) | 438 | test (subProp . cM) |
@@ -472,16 +465,16 @@ runTests n = do | |||
472 | putStrLn "------ svd" | 465 | putStrLn "------ svd" |
473 | test (svdProp1 . rM) | 466 | test (svdProp1 . rM) |
474 | test (svdProp1 . cM) | 467 | test (svdProp1 . cM) |
475 | test (svdProp1a svdR) | 468 | test (svdProp1a svd . rM) |
476 | test (svdProp1a svdC) | 469 | test (svdProp1a svd . cM) |
477 | test (svdProp1a svdRd) | 470 | -- test (svdProp1a svdRd) |
478 | test (svdProp1b svdR) | 471 | test (svdProp1b svd . rM) |
479 | test (svdProp1b svdC) | 472 | test (svdProp1b svd . cM) |
480 | test (svdProp1b svdRd) | 473 | -- test (svdProp1b svdRd) |
481 | test (svdProp2 thinSVDR) | 474 | test (svdProp2 thinSVD . rM) |
482 | test (svdProp2 thinSVDC) | 475 | test (svdProp2 thinSVD . cM) |
483 | test (svdProp2 thinSVDRd) | 476 | -- test (svdProp2 thinSVDRd) |
484 | test (svdProp2 thinSVDCd) | 477 | -- test (svdProp2 thinSVDCd) |
485 | test (svdProp3 . rM) | 478 | test (svdProp3 . rM) |
486 | test (svdProp3 . cM) | 479 | test (svdProp3 . cM) |
487 | test (svdProp4 . rM) | 480 | test (svdProp4 . rM) |
@@ -494,10 +487,10 @@ runTests n = do | |||
494 | test (svdProp7 . cM) | 487 | test (svdProp7 . cM) |
495 | putStrLn "------ svdCd" | 488 | putStrLn "------ svdCd" |
496 | #ifdef NOZGESDD | 489 | #ifdef NOZGESDD |
497 | putStrLn "Omitted" | 490 | -- putStrLn "Omitted" |
498 | #else | 491 | #else |
499 | test (svdProp1a svdCd) | 492 | -- test (svdProp1a svdCd) |
500 | test (svdProp1b svdCd) | 493 | -- test (svdProp1b svdCd) |
501 | #endif | 494 | #endif |
502 | putStrLn "------ eig" | 495 | putStrLn "------ eig" |
503 | test (eigSHProp . rHer) | 496 | test (eigSHProp . rHer) |
@@ -515,10 +508,10 @@ runTests n = do | |||
515 | test (qrProp . rM) | 508 | test (qrProp . rM) |
516 | test (qrProp . cM) | 509 | test (qrProp . cM) |
517 | test (rqProp . rM) | 510 | test (rqProp . rM) |
518 | test (rqProp . cM) | 511 | -- test (rqProp . cM) |
519 | test (rqProp1 . cM) | 512 | test (rqProp1 . cM) |
520 | test (rqProp2 . cM) | 513 | test (rqProp2 . cM) |
521 | test (rqProp3 . cM) | 514 | -- test (rqProp3 . cM) |
522 | putStrLn "------ hess" | 515 | putStrLn "------ hess" |
523 | test (hessProp . rSq) | 516 | test (hessProp . rSq) |
524 | test (hessProp . cSq) | 517 | test (hessProp . cSq) |
@@ -540,11 +533,11 @@ runTests n = do | |||
540 | test (\u -> cos u * tan u |~| sin (u::RM)) | 533 | test (\u -> cos u * tan u |~| sin (u::RM)) |
541 | test $ (\u -> cos u * tan u |~| sin (u::CM)) . liftMatrix makeUnitary | 534 | test $ (\u -> cos u * tan u |~| sin (u::CM)) . liftMatrix makeUnitary |
542 | putStrLn "------ vector operations - Float" | 535 | putStrLn "------ vector operations - Float" |
543 | test (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::FM)) | 536 | -- test (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::FM)) |
544 | test $ (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::ZM)) . liftMatrix makeUnitary | 537 | -- test $ (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::ZM)) . liftMatrix makeUnitary |
545 | test (\u -> sin u ** 2 + cos u ** 2 |~~| (1::FM)) | 538 | -- test (\u -> sin u ** 2 + cos u ** 2 |~~| (1::FM)) |
546 | test (\u -> cos u * tan u |~~| sin (u::FM)) | 539 | -- test (\u -> cos u * tan u |~~| sin (u::FM)) |
547 | test $ (\u -> cos u * tan u |~~| sin (u::ZM)) . liftMatrix makeUnitary | 540 | -- test $ (\u -> cos u * tan u |~~| sin (u::ZM)) . liftMatrix makeUnitary |
548 | putStrLn "------ read . show" | 541 | putStrLn "------ read . show" |
549 | test (\m -> (m::RM) == read (show m)) | 542 | test (\m -> (m::RM) == read (show m)) |
550 | test (\m -> (m::CM) == read (show m)) | 543 | test (\m -> (m::CM) == read (show m)) |
@@ -562,8 +555,8 @@ runTests n = do | |||
562 | , utest "expm1" (expmTest1) | 555 | , utest "expm1" (expmTest1) |
563 | , utest "expm2" (expmTest2) | 556 | , utest "expm2" (expmTest2) |
564 | , utest "arith1" $ ((ones (100,100) * 5 + 2)/0.5 - 7)**2 |~| (49 :: RM) | 557 | , utest "arith1" $ ((ones (100,100) * 5 + 2)/0.5 - 7)**2 |~| (49 :: RM) |
565 | , utest "arith2" $ ((scalar (1+i) * ones (100,100) * 5 + 2)/0.5 - 7)**2 |~| ( scalar (140*i-51) :: CM) | 558 | , utest "arith2" $ ((scalar (1+iC) * ones (100,100) * 5 + 2)/0.5 - 7)**2 |~| ( scalar (140*iC-51) :: CM) |
566 | , utest "arith3" $ exp (scalar i * ones(10,10)*pi) + 1 |~| 0 | 559 | , utest "arith3" $ exp (scalar iC * ones(10,10)*pi) + 1 |~| 0 |
567 | , utest "<\\>" $ (3><2) [2,0,0,3,1,1::Double] <\> 3|>[4,9,5] |~| 2|>[2,3] | 560 | , utest "<\\>" $ (3><2) [2,0,0,3,1,1::Double] <\> 3|>[4,9,5] |~| 2|>[2,3] |
568 | -- , utest "gamma" (gamma 5 == 24.0) | 561 | -- , utest "gamma" (gamma 5 == 24.0) |
569 | -- , besselTest | 562 | -- , besselTest |
@@ -571,10 +564,10 @@ runTests n = do | |||
571 | , utest "randomGaussian" randomTestGaussian | 564 | , utest "randomGaussian" randomTestGaussian |
572 | , utest "randomUniform" randomTestUniform | 565 | , utest "randomUniform" randomTestUniform |
573 | , utest "buildVector/Matrix" $ | 566 | , utest "buildVector/Matrix" $ |
574 | complex (10 |> [0::Double ..]) == buildVector 10 fromIntegral | 567 | complex (10 |> [0::Double ..]) == build 10 id |
575 | && ident 5 == buildMatrix 5 5 (\(r,c) -> if r==c then 1::Double else 0) | 568 | && ident 5 == build (5,5) (\r c -> if r==c then 1::Double else 0) |
576 | , utest "rank" $ rank ((2><3)[1,0,0,1,5*eps,0]) == 1 | 569 | , utest "rank" $ rank ((2><3)[1,0,0,1,5*peps,0::Double]) == 1 |
577 | && rank ((2><3)[1,0,0,1,7*eps,0]) == 2 | 570 | && rank ((2><3)[1,0,0,1,7*peps,0::Double]) == 2 |
578 | , utest "block" $ fromBlocks [[ident 3,0],[0,ident 4]] == (ident 7 :: CM) | 571 | , utest "block" $ fromBlocks [[ident 3,0],[0,ident 4]] == (ident 7 :: CM) |
579 | , mbCholTest | 572 | , mbCholTest |
580 | , utest "offset" offsetTest | 573 | , utest "offset" offsetTest |
@@ -602,7 +595,7 @@ a |~~| b = a :~6~: b | |||
602 | 595 | ||
603 | makeUnitary v | realPart n > 1 = v / scalar n | 596 | makeUnitary v | realPart n > 1 = v / scalar n |
604 | | otherwise = v | 597 | | otherwise = v |
605 | where n = sqrt (v <.> v) | 598 | where n = sqrt (v `dot` v) |
606 | 599 | ||
607 | -- -- | Some additional tests on big matrices. They take a few minutes. | 600 | -- -- | Some additional tests on big matrices. They take a few minutes. |
608 | -- runBigTests :: IO () | 601 | -- runBigTests :: IO () |
@@ -668,9 +661,9 @@ manyvec5 xs = sumElements $ fromRows $ map (\x -> vec3 x (x**2) (x**3)) xs | |||
668 | 661 | ||
669 | 662 | ||
670 | manyvec2 xs = sum $ map (\x -> sqrt(x^2 + (x**2)^2 +(x**3)^2)) xs | 663 | manyvec2 xs = sum $ map (\x -> sqrt(x^2 + (x**2)^2 +(x**3)^2)) xs |
671 | manyvec3 xs = sum $ map (pnorm PNorm2 . (\x -> fromList [x,x**2,x**3])) xs | 664 | manyvec3 xs = sum $ map (norm_2 . (\x -> fromList [x,x**2,x**3])) xs |
672 | 665 | ||
673 | manyvec4 xs = sum $ map (pnorm PNorm2 . (\x -> vec3 x (x**2) (x**3))) xs | 666 | manyvec4 xs = sum $ map (norm_2 . (\x -> vec3 x (x**2) (x**3))) xs |
674 | 667 | ||
675 | vec3 :: Double -> Double -> Double -> Vector Double | 668 | vec3 :: Double -> Double -> Double -> Vector Double |
676 | vec3 a b c = runSTVector $ do | 669 | vec3 a b c = runSTVector $ do |
@@ -695,11 +688,11 @@ mkVecBench = do | |||
695 | 688 | ||
696 | subBench = do | 689 | subBench = do |
697 | putStrLn "" | 690 | putStrLn "" |
698 | let g = foldl1' (.) (replicate (10^5) (\v -> subVector 1 (dim v -1) v)) | 691 | let g = foldl1' (.) (replicate (10^5) (\v -> subVector 1 (size v -1) v)) |
699 | time "0.1M subVector " (g (konst 1 (1+10^5) :: Vector Double) @> 0) | 692 | time "0.1M subVector " (g (konst 1 (1+10^5) :: Vector Double) ! 0) |
700 | let f = foldl1' (.) (replicate (10^5) (fromRows.toRows)) | 693 | let f = foldl1' (.) (replicate (10^5) (fromRows.toRows)) |
701 | time "subVector-join 3" (f (ident 3 :: Matrix Double) @@>(0,0)) | 694 | time "subVector-join 3" (f (ident 3 :: Matrix Double) `atIndex` (0,0)) |
702 | time "subVector-join 10" (f (ident 10 :: Matrix Double) @@>(0,0)) | 695 | time "subVector-join 10" (f (ident 10 :: Matrix Double) `atIndex` (0,0)) |
703 | 696 | ||
704 | -------------------------------- | 697 | -------------------------------- |
705 | 698 | ||
@@ -724,7 +717,7 @@ multBench = do | |||
724 | 717 | ||
725 | eigBench = do | 718 | eigBench = do |
726 | let m = reshape 1000 (randomVector 777 Uniform (1000*1000)) | 719 | let m = reshape 1000 (randomVector 777 Uniform (1000*1000)) |
727 | s = m + trans m | 720 | s = m + tr m |
728 | m `seq` s `seq` putStrLn "" | 721 | m `seq` s `seq` putStrLn "" |
729 | time "eigenvalues symmetric 1000x1000" (eigenvaluesSH' m) | 722 | time "eigenvalues symmetric 1000x1000" (eigenvaluesSH' m) |
730 | time "eigenvectors symmetric 1000x1000" (snd $ eigSH' m) | 723 | time "eigenvectors symmetric 1000x1000" (snd $ eigSH' m) |
@@ -736,7 +729,7 @@ eigBench = do | |||
736 | svdBench = do | 729 | svdBench = do |
737 | let a = reshape 500 (randomVector 777 Uniform (3000*500)) | 730 | let a = reshape 500 (randomVector 777 Uniform (3000*500)) |
738 | b = reshape 1000 (randomVector 777 Uniform (1000*1000)) | 731 | b = reshape 1000 (randomVector 777 Uniform (1000*1000)) |
739 | fv (_,_,v) = v@@>(0,0) | 732 | fv (_,_,v) = v `atIndex` (0,0) |
740 | a `seq` b `seq` putStrLn "" | 733 | a `seq` b `seq` putStrLn "" |
741 | time "singular values 3000x500" (singularValues a) | 734 | time "singular values 3000x500" (singularValues a) |
742 | time "thin svd 3000x500" (fv $ thinSVD a) | 735 | time "thin svd 3000x500" (fv $ thinSVD a) |
@@ -748,7 +741,7 @@ svdBench = do | |||
748 | 741 | ||
749 | solveBenchN n = do | 742 | solveBenchN n = do |
750 | let x = uniformSample 777 (2*n) (replicate n (-1,1)) | 743 | let x = uniformSample 777 (2*n) (replicate n (-1,1)) |
751 | a = trans x <> x | 744 | a = tr x <> x |
752 | b = asColumn $ randomVector 666 Uniform n | 745 | b = asColumn $ randomVector 666 Uniform n |
753 | a `seq` b `seq` putStrLn "" | 746 | a `seq` b `seq` putStrLn "" |
754 | time ("svd solve " ++ show n) (linearSolveSVD a b) | 747 | time ("svd solve " ++ show n) (linearSolveSVD a b) |
@@ -765,7 +758,7 @@ solveBench = do | |||
765 | 758 | ||
766 | cholBenchN n = do | 759 | cholBenchN n = do |
767 | let x = uniformSample 777 (2*n) (replicate n (-1,1)) | 760 | let x = uniformSample 777 (2*n) (replicate n (-1,1)) |
768 | a = trans x <> x | 761 | a = tr x <> x |
769 | a `seq` putStr "" | 762 | a `seq` putStr "" |
770 | time ("chol " ++ show n) (chol a) | 763 | time ("chol " ++ show n) (chol a) |
771 | 764 | ||
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs index 53fc4d2..e2c3840 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs | |||
@@ -26,9 +26,8 @@ module Numeric.LinearAlgebra.Tests.Instances( | |||
26 | 26 | ||
27 | import System.Random | 27 | import System.Random |
28 | 28 | ||
29 | import Numeric.LinearAlgebra | 29 | import Numeric.LinearAlgebra.HMatrix hiding (vector) |
30 | import Numeric.LinearAlgebra.Devel | 30 | import Numeric.LinearAlgebra.Devel |
31 | import Numeric.Container | ||
32 | import Control.Monad(replicateM) | 31 | import Control.Monad(replicateM) |
33 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector | 32 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector |
34 | ,sized,classify,Testable,Property | 33 | ,sized,classify,Testable,Property |
@@ -130,7 +129,7 @@ instance (Field a, Arbitrary a, Num (Vector a)) => Arbitrary (Her a) where | |||
130 | arbitrary = do | 129 | arbitrary = do |
131 | Sq m <- arbitrary | 130 | Sq m <- arbitrary |
132 | let m' = m/2 | 131 | let m' = m/2 |
133 | return $ Her (m' + ctrans m') | 132 | return $ Her (m' + tr m') |
134 | 133 | ||
135 | #if MIN_VERSION_QuickCheck(2,0,0) | 134 | #if MIN_VERSION_QuickCheck(2,0,0) |
136 | #else | 135 | #else |
@@ -144,7 +143,7 @@ instance ArbitraryField (Complex Double) | |||
144 | 143 | ||
145 | -- a well-conditioned general matrix (the singular values are between 1 and 100) | 144 | -- a well-conditioned general matrix (the singular values are between 1 and 100) |
146 | newtype (WC a) = WC (Matrix a) deriving Show | 145 | newtype (WC a) = WC (Matrix a) deriving Show |
147 | instance (ArbitraryField a) => Arbitrary (WC a) where | 146 | instance (Numeric a, ArbitraryField a) => Arbitrary (WC a) where |
148 | arbitrary = do | 147 | arbitrary = do |
149 | m <- arbitrary | 148 | m <- arbitrary |
150 | let (u,_,v) = svd m | 149 | let (u,_,v) = svd m |
@@ -153,7 +152,7 @@ instance (ArbitraryField a) => Arbitrary (WC a) where | |||
153 | n = min r c | 152 | n = min r c |
154 | sv' <- replicateM n (choose (1,100)) | 153 | sv' <- replicateM n (choose (1,100)) |
155 | let s = diagRect 0 (fromList sv') r c | 154 | let s = diagRect 0 (fromList sv') r c |
156 | return $ WC (u `mXm` real s `mXm` trans v) | 155 | return $ WC (u <> real s <> tr v) |
157 | 156 | ||
158 | #if MIN_VERSION_QuickCheck(2,0,0) | 157 | #if MIN_VERSION_QuickCheck(2,0,0) |
159 | #else | 158 | #else |
@@ -163,14 +162,14 @@ instance (ArbitraryField a) => Arbitrary (WC a) where | |||
163 | 162 | ||
164 | -- a well-conditioned square matrix (the singular values are between 1 and 100) | 163 | -- a well-conditioned square matrix (the singular values are between 1 and 100) |
165 | newtype (SqWC a) = SqWC (Matrix a) deriving Show | 164 | newtype (SqWC a) = SqWC (Matrix a) deriving Show |
166 | instance (ArbitraryField a) => Arbitrary (SqWC a) where | 165 | instance (ArbitraryField a, Numeric a) => Arbitrary (SqWC a) where |
167 | arbitrary = do | 166 | arbitrary = do |
168 | Sq m <- arbitrary | 167 | Sq m <- arbitrary |
169 | let (u,_,v) = svd m | 168 | let (u,_,v) = svd m |
170 | n = rows m | 169 | n = rows m |
171 | sv' <- replicateM n (choose (1,100)) | 170 | sv' <- replicateM n (choose (1,100)) |
172 | let s = diag (fromList sv') | 171 | let s = diag (fromList sv') |
173 | return $ SqWC (u `mXm` real s `mXm` trans v) | 172 | return $ SqWC (u <> real s <> tr v) |
174 | 173 | ||
175 | #if MIN_VERSION_QuickCheck(2,0,0) | 174 | #if MIN_VERSION_QuickCheck(2,0,0) |
176 | #else | 175 | #else |
@@ -180,7 +179,7 @@ instance (ArbitraryField a) => Arbitrary (SqWC a) where | |||
180 | 179 | ||
181 | -- a positive definite square matrix (the eigenvalues are between 0 and 100) | 180 | -- a positive definite square matrix (the eigenvalues are between 0 and 100) |
182 | newtype (PosDef a) = PosDef (Matrix a) deriving Show | 181 | newtype (PosDef a) = PosDef (Matrix a) deriving Show |
183 | instance (ArbitraryField a, Num (Vector a)) | 182 | instance (Numeric a, ArbitraryField a, Num (Vector a)) |
184 | => Arbitrary (PosDef a) where | 183 | => Arbitrary (PosDef a) where |
185 | arbitrary = do | 184 | arbitrary = do |
186 | Her m <- arbitrary | 185 | Her m <- arbitrary |
@@ -188,8 +187,8 @@ instance (ArbitraryField a, Num (Vector a)) | |||
188 | n = rows m | 187 | n = rows m |
189 | l <- replicateM n (choose (0,100)) | 188 | l <- replicateM n (choose (0,100)) |
190 | let s = diag (fromList l) | 189 | let s = diag (fromList l) |
191 | p = v `mXm` real s `mXm` ctrans v | 190 | p = v <> real s <> tr v |
192 | return $ PosDef (0.5 * p + 0.5 * ctrans p) | 191 | return $ PosDef (0.5 * p + 0.5 * tr p) |
193 | 192 | ||
194 | #if MIN_VERSION_QuickCheck(2,0,0) | 193 | #if MIN_VERSION_QuickCheck(2,0,0) |
195 | #else | 194 | #else |
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs index a5c37f4..d9645c3 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs | |||
@@ -1,6 +1,6 @@ | |||
1 | {-# LANGUAGE CPP, FlexibleContexts #-} | 1 | {-# LANGUAGE CPP, FlexibleContexts #-} |
2 | {-# OPTIONS_GHC -fno-warn-unused-imports #-} | 2 | {-# OPTIONS_GHC -fno-warn-unused-imports #-} |
3 | {-# LANGUAGE TypeFamilies #-} | 3 | {-# LANGUAGE GADTs #-} |
4 | 4 | ||
5 | ----------------------------------------------------------------------------- | 5 | ----------------------------------------------------------------------------- |
6 | {- | | 6 | {- | |
@@ -29,7 +29,7 @@ module Numeric.LinearAlgebra.Tests.Properties ( | |||
29 | pinvProp, | 29 | pinvProp, |
30 | detProp, | 30 | detProp, |
31 | nullspaceProp, | 31 | nullspaceProp, |
32 | bugProp, | 32 | -- bugProp, |
33 | svdProp1, svdProp1a, svdProp1b, svdProp2, svdProp3, svdProp4, | 33 | svdProp1, svdProp1a, svdProp1b, svdProp2, svdProp3, svdProp4, |
34 | svdProp5a, svdProp5b, svdProp6a, svdProp6b, svdProp7, | 34 | svdProp5a, svdProp5b, svdProp6a, svdProp6b, svdProp7, |
35 | eigProp, eigSHProp, eigProp2, eigSHProp2, | 35 | eigProp, eigSHProp, eigProp2, eigSHProp2, |
@@ -43,9 +43,7 @@ module Numeric.LinearAlgebra.Tests.Properties ( | |||
43 | linearSolveProp, linearSolveProp2 | 43 | linearSolveProp, linearSolveProp2 |
44 | ) where | 44 | ) where |
45 | 45 | ||
46 | import Numeric.Container | 46 | import Numeric.LinearAlgebra.HMatrix hiding (Testable)--hiding (real,complex) |
47 | import Numeric.LinearAlgebra --hiding (real,complex) | ||
48 | import Numeric.LinearAlgebra.LAPACK | ||
49 | import Debug.Trace | 47 | import Debug.Trace |
50 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector | 48 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector |
51 | ,sized,classify,Testable,Property | 49 | ,sized,classify,Testable,Property |
@@ -55,8 +53,8 @@ trivial :: Testable a => Bool -> a -> Property | |||
55 | trivial = (`classify` "trivial") | 53 | trivial = (`classify` "trivial") |
56 | 54 | ||
57 | -- relative error | 55 | -- relative error |
58 | dist :: (Normed c t, Num (c t)) => c t -> c t -> Double | 56 | dist :: (Num a, Normed a) => a -> a -> Double |
59 | dist = relativeError Infinity | 57 | dist = relativeError norm_Inf |
60 | 58 | ||
61 | infixl 4 |~| | 59 | infixl 4 |~| |
62 | a |~| b = a :~10~: b | 60 | a |~| b = a :~10~: b |
@@ -73,11 +71,11 @@ a :~n~: b = dist a b < 10^^(-n) | |||
73 | square m = rows m == cols m | 71 | square m = rows m == cols m |
74 | 72 | ||
75 | -- orthonormal columns | 73 | -- orthonormal columns |
76 | orthonormal m = ctrans m <> m |~| ident (cols m) | 74 | orthonormal m = tr m <> m |~| ident (cols m) |
77 | 75 | ||
78 | unitary m = square m && orthonormal m | 76 | unitary m = square m && orthonormal m |
79 | 77 | ||
80 | hermitian m = square m && m |~| ctrans m | 78 | hermitian m = square m && m |~| tr m |
81 | 79 | ||
82 | wellCond m = rcond m > 1/100 | 80 | wellCond m = rcond m > 1/100 |
83 | 81 | ||
@@ -85,12 +83,12 @@ positiveDefinite m = minimum (toList e) > 0 | |||
85 | where (e,_v) = eigSH m | 83 | where (e,_v) = eigSH m |
86 | 84 | ||
87 | upperTriang m = rows m == 1 || down == z | 85 | upperTriang m = rows m == 1 || down == z |
88 | where down = fromList $ concat $ zipWith drop [1..] (toLists (ctrans m)) | 86 | where down = fromList $ concat $ zipWith drop [1..] (toLists (tr m)) |
89 | z = konst 0 (dim down) | 87 | z = konst 0 (size down) |
90 | 88 | ||
91 | upperHessenberg m = rows m < 3 || down == z | 89 | upperHessenberg m = rows m < 3 || down == z |
92 | where down = fromList $ concat $ zipWith drop [2..] (toLists (ctrans m)) | 90 | where down = fromList $ concat $ zipWith drop [2..] (toLists (tr m)) |
93 | z = konst 0 (dim down) | 91 | z = konst 0 (size down) |
94 | 92 | ||
95 | zeros (r,c) = reshape c (konst 0 (r*c)) | 93 | zeros (r,c) = reshape c (konst 0 (r*c)) |
96 | 94 | ||
@@ -118,81 +116,94 @@ detProp m = s d1 |~| s d2 | |||
118 | s x = fromList [x] | 116 | s x = fromList [x] |
119 | 117 | ||
120 | nullspaceProp m = null nl `trivial` (null nl || m <> n |~| zeros (r,c) | 118 | nullspaceProp m = null nl `trivial` (null nl || m <> n |~| zeros (r,c) |
121 | && orthonormal (fromColumns nl)) | 119 | && orthonormal n) |
122 | where nl = nullspacePrec 1 m | 120 | where n = nullspaceSVD (Left (1*peps)) m (rightSV m) |
123 | n = fromColumns nl | 121 | nl = toColumns n |
124 | r = rows m | 122 | r = rows m |
125 | c = cols m - rank m | 123 | c = cols m - rank m |
126 | 124 | ||
127 | ------------------------------------------------------------------ | 125 | ------------------------------------------------------------------ |
128 | 126 | {- | |
129 | -- testcase for nonempty fpu stack | 127 | -- testcase for nonempty fpu stack |
130 | -- uncommenting unitary' signature eliminates the problem | 128 | -- uncommenting unitary' signature eliminates the problem |
131 | bugProp m = m |~| u <> real d <> trans v && unitary' u && unitary' v | 129 | bugProp m = m |~| u <> real d <> tr v && unitary' u && unitary' v |
132 | where (u,d,v) = fullSVD m | 130 | where (u,d,v) = svd m |
133 | -- unitary' :: (Num (Vector t), Field t) => Matrix t -> Bool | 131 | -- unitary' :: (Num (Vector t), Field t) => Matrix t -> Bool |
134 | unitary' a = unitary a | 132 | unitary' a = unitary a |
135 | 133 | -} | |
136 | ------------------------------------------------------------------ | 134 | ------------------------------------------------------------------ |
137 | 135 | ||
138 | -- fullSVD | 136 | -- fullSVD |
139 | svdProp1 m = m |~| u <> real d <> trans v && unitary u && unitary v | 137 | svdProp1 m = m |~| u <> real d <> tr v && unitary u && unitary v |
140 | where (u,d,v) = fullSVD m | 138 | where |
139 | (u,s,v) = svd m | ||
140 | d = diagRect 0 s (rows m) (cols m) | ||
141 | 141 | ||
142 | svdProp1a svdfun m = m |~| u <> real d <> trans v && unitary u && unitary v where | 142 | svdProp1a svdfun m = m |~| u <> real d <> tr v && unitary u && unitary v |
143 | where | ||
143 | (u,s,v) = svdfun m | 144 | (u,s,v) = svdfun m |
144 | d = diagRect 0 s (rows m) (cols m) | 145 | d = diagRect 0 s (rows m) (cols m) |
145 | 146 | ||
146 | svdProp1b svdfun m = unitary u && unitary v where | 147 | svdProp1b svdfun m = unitary u && unitary v |
148 | where | ||
147 | (u,_,v) = svdfun m | 149 | (u,_,v) = svdfun m |
148 | 150 | ||
149 | -- thinSVD | 151 | -- thinSVD |
150 | svdProp2 thinSVDfun m = m |~| u <> diag (real s) <> trans v && orthonormal u && orthonormal v && dim s == min (rows m) (cols m) | 152 | svdProp2 thinSVDfun m |
151 | where (u,s,v) = thinSVDfun m | 153 | = m |~| u <> diag (real s) <> tr v |
154 | && orthonormal u && orthonormal v | ||
155 | && size s == min (rows m) (cols m) | ||
156 | where | ||
157 | (u,s,v) = thinSVDfun m | ||
152 | 158 | ||
153 | -- compactSVD | 159 | -- compactSVD |
154 | svdProp3 m = (m |~| u <> real (diag s) <> trans v | 160 | svdProp3 m = (m |~| u <> real (diag s) <> tr v |
155 | && orthonormal u && orthonormal v) | 161 | && orthonormal u && orthonormal v) |
156 | where (u,s,v) = compactSVD m | 162 | where |
163 | (u,s,v) = compactSVD m | ||
157 | 164 | ||
158 | svdProp4 m' = m |~| u <> real (diag s) <> trans v | 165 | svdProp4 m' = m |~| u <> real (diag s) <> tr v |
159 | && orthonormal u && orthonormal v | 166 | && orthonormal u && orthonormal v |
160 | && (dim s == r || r == 0 && dim s == 1) | 167 | && (size s == r || r == 0 && size s == 1) |
161 | where (u,s,v) = compactSVD m | 168 | where |
162 | m = fromBlocks [[m'],[m']] | 169 | (u,s,v) = compactSVD m |
163 | r = rank m' | 170 | m = fromBlocks [[m'],[m']] |
164 | 171 | r = rank m' | |
165 | svdProp5a m = all (s1|~|) [s2,s3,s4,s5,s6] where | 172 | |
166 | s1 = svR m | 173 | svdProp5a m = all (s1|~|) [s3,s5] where |
167 | s2 = svRd m | 174 | s1 = singularValues (m :: Matrix Double) |
168 | (_,s3,_) = svdR m | 175 | -- s2 = svRd m |
169 | (_,s4,_) = svdRd m | 176 | (_,s3,_) = svd m |
170 | (_,s5,_) = thinSVDR m | 177 | -- (_,s4,_) = svdRd m |
171 | (_,s6,_) = thinSVDRd m | 178 | (_,s5,_) = thinSVD m |
172 | 179 | -- (_,s6,_) = thinSVDRd m | |
173 | svdProp5b m = all (s1|~|) [s2,s3,s4,s5,s6] where | 180 | |
174 | s1 = svC m | 181 | svdProp5b m = all (s1|~|) [s3,s5] where |
175 | s2 = svCd m | 182 | s1 = singularValues (m :: Matrix (Complex Double)) |
176 | (_,s3,_) = svdC m | 183 | -- s2 = svCd m |
177 | (_,s4,_) = svdCd m | 184 | (_,s3,_) = svd m |
178 | (_,s5,_) = thinSVDC m | 185 | -- (_,s4,_) = svdCd m |
179 | (_,s6,_) = thinSVDCd m | 186 | (_,s5,_) = thinSVD m |
187 | -- (_,s6,_) = thinSVDCd m | ||
180 | 188 | ||
181 | svdProp6a m = s |~| s' && v |~| v' && s |~| s'' && u |~| u' | 189 | svdProp6a m = s |~| s' && v |~| v' && s |~| s'' && u |~| u' |
182 | where (u,s,v) = svdR m | 190 | where |
183 | (s',v') = rightSVR m | 191 | (u,s,v) = svd (m :: Matrix Double) |
184 | (u',s'') = leftSVR m | 192 | (s',v') = rightSV m |
193 | (u',s'') = leftSV m | ||
185 | 194 | ||
186 | svdProp6b m = s |~| s' && v |~| v' && s |~| s'' && u |~| u' | 195 | svdProp6b m = s |~| s' && v |~| v' && s |~| s'' && u |~| u' |
187 | where (u,s,v) = svdC m | 196 | where |
188 | (s',v') = rightSVC m | 197 | (u,s,v) = svd (m :: Matrix (Complex Double)) |
189 | (u',s'') = leftSVC m | 198 | (s',v') = rightSV m |
199 | (u',s'') = leftSV m | ||
190 | 200 | ||
191 | svdProp7 m = s |~| s' && u |~| u' && v |~| v' && s |~| s''' | 201 | svdProp7 m = s |~| s' && u |~| u' && v |~| v' && s |~| s''' |
192 | where (u,s,v) = svd m | 202 | where |
193 | (s',v') = rightSV m | 203 | (u,s,v) = svd m |
194 | (u',_s'') = leftSV m | 204 | (s',v') = rightSV m |
195 | s''' = singularValues m | 205 | (u',_s'') = leftSV m |
206 | s''' = singularValues m | ||
196 | 207 | ||
197 | ------------------------------------------------------------------ | 208 | ------------------------------------------------------------------ |
198 | 209 | ||
@@ -201,7 +212,7 @@ eigProp m = complex m <> v |~| v <> diag s | |||
201 | 212 | ||
202 | eigSHProp m = m <> v |~| v <> real (diag s) | 213 | eigSHProp m = m <> v |~| v <> real (diag s) |
203 | && unitary v | 214 | && unitary v |
204 | && m |~| v <> real (diag s) <> ctrans v | 215 | && m |~| v <> real (diag s) <> tr v |
205 | where (s, v) = eigSH m | 216 | where (s, v) = eigSH m |
206 | 217 | ||
207 | eigProp2 m = fst (eig m) |~| eigenvalues m | 218 | eigProp2 m = fst (eig m) |~| eigenvalues m |
@@ -226,19 +237,19 @@ rqProp3 m = upperTriang' r | |||
226 | where (r,_q) = rq m | 237 | where (r,_q) = rq m |
227 | 238 | ||
228 | upperTriang' r = upptr (rows r) (cols r) * r |~| r | 239 | upperTriang' r = upptr (rows r) (cols r) * r |~| r |
229 | where upptr f c = buildMatrix f c $ \(r',c') -> if r'-t > c' then 0 else 1 | 240 | where upptr f c = build (f,c) $ \r' c' -> if r'-t > c' then 0 else 1 |
230 | where t = f-c | 241 | where t = fromIntegral (f-c) |
231 | 242 | ||
232 | hessProp m = m |~| p <> h <> ctrans p && unitary p && upperHessenberg h | 243 | hessProp m = m |~| p <> h <> tr p && unitary p && upperHessenberg h |
233 | where (p,h) = hess m | 244 | where (p,h) = hess m |
234 | 245 | ||
235 | schurProp1 m = m |~| u <> s <> ctrans u && unitary u && upperTriang s | 246 | schurProp1 m = m |~| u <> s <> tr u && unitary u && upperTriang s |
236 | where (u,s) = schur m | 247 | where (u,s) = schur m |
237 | 248 | ||
238 | schurProp2 m = m |~| u <> s <> ctrans u && unitary u && upperHessenberg s -- fixme | 249 | schurProp2 m = m |~| u <> s <> tr u && unitary u && upperHessenberg s -- fixme |
239 | where (u,s) = schur m | 250 | where (u,s) = schur m |
240 | 251 | ||
241 | cholProp m = m |~| ctrans c <> c && upperTriang c | 252 | cholProp m = m |~| tr c <> c && upperTriang c |
242 | where c = chol m | 253 | where c = chol m |
243 | 254 | ||
244 | exactProp m = chol m == chol (m+0) | 255 | exactProp m = chol m == chol (m+0) |
@@ -252,7 +263,7 @@ mulH a b = fromLists [[ doth ai bj | bj <- toColumns b] | ai <- toRows a ] | |||
252 | 263 | ||
253 | multProp1 p (a,b) = (a <> b) :~p~: (mulH a b) | 264 | multProp1 p (a,b) = (a <> b) :~p~: (mulH a b) |
254 | 265 | ||
255 | multProp2 p (a,b) = (ctrans (a <> b)) :~p~: (ctrans b <> ctrans a) | 266 | multProp2 p (a,b) = (tr (a <> b)) :~p~: (tr b <> tr a) |
256 | 267 | ||
257 | linearSolveProp f m = f m m |~| ident (rows m) | 268 | linearSolveProp f m = f m m |~| ident (rows m) |
258 | 269 | ||
@@ -261,5 +272,5 @@ linearSolveProp2 f (a,x) = not wc `trivial` (not wc || a <> f a b |~| b) | |||
261 | b = a <> x | 272 | b = a <> x |
262 | wc = rank a == q | 273 | wc = rank a == q |
263 | 274 | ||
264 | subProp m = m == (trans . fromColumns . toRows) m | 275 | subProp m = m == (tr . fromColumns . toRows) m |
265 | 276 | ||