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