diff options
Diffstat (limited to 'packages/tests/src/Numeric/LinearAlgebra/Tests.hs')
-rw-r--r-- | packages/tests/src/Numeric/LinearAlgebra/Tests.hs | 202 |
1 files changed, 89 insertions, 113 deletions
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs index 713af79..71c7c16 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs | |||
@@ -28,12 +28,9 @@ module Numeric.LinearAlgebra.Tests( | |||
28 | --, runBigTests | 28 | --, runBigTests |
29 | ) where | 29 | ) where |
30 | 30 | ||
31 | import Numeric.LinearAlgebra | 31 | import Numeric.LinearAlgebra hiding (unitary) |
32 | import Numeric.LinearAlgebra.HMatrix hiding ((<>),linearSolve) | 32 | import Numeric.LinearAlgebra.Devel hiding (vec) |
33 | import Numeric.LinearAlgebra.Static(L) | 33 | 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 | 34 | import Numeric.LinearAlgebra.Tests.Instances |
38 | import Numeric.LinearAlgebra.Tests.Properties | 35 | import Numeric.LinearAlgebra.Tests.Properties |
39 | import Test.HUnit hiding ((~:),test,Testable,State) | 36 | import Test.HUnit hiding ((~:),test,Testable,State) |
@@ -44,16 +41,13 @@ import qualified Prelude | |||
44 | import System.CPUTime | 41 | import System.CPUTime |
45 | import System.Exit | 42 | import System.Exit |
46 | import Text.Printf | 43 | import Text.Printf |
47 | import Data.Packed.Development(unsafeFromForeignPtr,unsafeToForeignPtr) | 44 | import Numeric.LinearAlgebra.Devel(unsafeFromForeignPtr,unsafeToForeignPtr) |
48 | import Control.Arrow((***)) | 45 | import Control.Arrow((***)) |
49 | import Debug.Trace | 46 | import Debug.Trace |
50 | import Control.Monad(when) | 47 | import Control.Monad(when) |
51 | import Numeric.LinearAlgebra.Util hiding (ones,row,col) | ||
52 | import Control.Applicative | 48 | import Control.Applicative |
53 | import Control.Monad(ap) | 49 | import Control.Monad(ap) |
54 | 50 | ||
55 | import Data.Packed.ST | ||
56 | |||
57 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector | 51 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector |
58 | ,sized,classify,Testable,Property | 52 | ,sized,classify,Testable,Property |
59 | ,quickCheckWithResult,maxSize,stdArgs,shrink) | 53 | ,quickCheckWithResult,maxSize,stdArgs,shrink) |
@@ -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,54 +168,54 @@ 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] |
225 | 219 | ||
226 | --------------------------------------------------------------------- | 220 | --------------------------------------------------------------------- |
227 | 221 | ||
@@ -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 |
@@ -377,23 +371,6 @@ convolutionTest = utest "convolution" ok | |||
377 | 371 | ||
378 | -------------------------------------------------------------------------------- | 372 | -------------------------------------------------------------------------------- |
379 | 373 | ||
380 | kroneckerTest = utest "kronecker" ok | ||
381 | where | ||
382 | a,x,b :: Matrix Double | ||
383 | a = (3><4) [1..] | ||
384 | x = (4><2) [3,5..] | ||
385 | b = (2><5) [0,5..] | ||
386 | v1 = vec (a <> x <> b) | ||
387 | v2 = (trans b `kronecker` a) <> vec x | ||
388 | s = trans b <> b | ||
389 | v3 = vec s | ||
390 | v4 = (dup 5 :: Matrix Double) <> vech s | ||
391 | ok = v1 == v2 && v3 == v4 | ||
392 | && vtrans 1 a == trans a | ||
393 | && vtrans (rows a) a == asColumn (vec a) | ||
394 | |||
395 | -------------------------------------------------------------------------------- | ||
396 | |||
397 | sparseTest = utest "sparse" (fst $ checkT (undefined :: GMatrix)) | 374 | sparseTest = utest "sparse" (fst $ checkT (undefined :: GMatrix)) |
398 | 375 | ||
399 | -------------------------------------------------------------------------------- | 376 | -------------------------------------------------------------------------------- |
@@ -435,11 +412,11 @@ runTests n = do | |||
435 | test (multProp1 10 . cConsist) | 412 | test (multProp1 10 . cConsist) |
436 | test (multProp2 10 . rConsist) | 413 | test (multProp2 10 . rConsist) |
437 | test (multProp2 10 . cConsist) | 414 | test (multProp2 10 . cConsist) |
438 | putStrLn "------ mult Float" | 415 | -- putStrLn "------ mult Float" |
439 | test (multProp1 6 . (single *** single) . rConsist) | 416 | -- test (multProp1 6 . (single *** single) . rConsist) |
440 | test (multProp1 6 . (single *** single) . cConsist) | 417 | -- test (multProp1 6 . (single *** single) . cConsist) |
441 | test (multProp2 6 . (single *** single) . rConsist) | 418 | -- test (multProp2 6 . (single *** single) . rConsist) |
442 | test (multProp2 6 . (single *** single) . cConsist) | 419 | -- test (multProp2 6 . (single *** single) . cConsist) |
443 | putStrLn "------ sub-trans" | 420 | putStrLn "------ sub-trans" |
444 | test (subProp . rM) | 421 | test (subProp . rM) |
445 | test (subProp . cM) | 422 | test (subProp . cM) |
@@ -472,16 +449,16 @@ runTests n = do | |||
472 | putStrLn "------ svd" | 449 | putStrLn "------ svd" |
473 | test (svdProp1 . rM) | 450 | test (svdProp1 . rM) |
474 | test (svdProp1 . cM) | 451 | test (svdProp1 . cM) |
475 | test (svdProp1a svdR) | 452 | test (svdProp1a svd . rM) |
476 | test (svdProp1a svdC) | 453 | test (svdProp1a svd . cM) |
477 | test (svdProp1a svdRd) | 454 | -- test (svdProp1a svdRd) |
478 | test (svdProp1b svdR) | 455 | test (svdProp1b svd . rM) |
479 | test (svdProp1b svdC) | 456 | test (svdProp1b svd . cM) |
480 | test (svdProp1b svdRd) | 457 | -- test (svdProp1b svdRd) |
481 | test (svdProp2 thinSVDR) | 458 | test (svdProp2 thinSVD . rM) |
482 | test (svdProp2 thinSVDC) | 459 | test (svdProp2 thinSVD . cM) |
483 | test (svdProp2 thinSVDRd) | 460 | -- test (svdProp2 thinSVDRd) |
484 | test (svdProp2 thinSVDCd) | 461 | -- test (svdProp2 thinSVDCd) |
485 | test (svdProp3 . rM) | 462 | test (svdProp3 . rM) |
486 | test (svdProp3 . cM) | 463 | test (svdProp3 . cM) |
487 | test (svdProp4 . rM) | 464 | test (svdProp4 . rM) |
@@ -492,12 +469,12 @@ runTests n = do | |||
492 | test (svdProp6b) | 469 | test (svdProp6b) |
493 | test (svdProp7 . rM) | 470 | test (svdProp7 . rM) |
494 | test (svdProp7 . cM) | 471 | test (svdProp7 . cM) |
495 | putStrLn "------ svdCd" | 472 | -- putStrLn "------ svdCd" |
496 | #ifdef NOZGESDD | 473 | #ifdef NOZGESDD |
497 | putStrLn "Omitted" | 474 | -- putStrLn "Omitted" |
498 | #else | 475 | #else |
499 | test (svdProp1a svdCd) | 476 | -- test (svdProp1a svdCd) |
500 | test (svdProp1b svdCd) | 477 | -- test (svdProp1b svdCd) |
501 | #endif | 478 | #endif |
502 | putStrLn "------ eig" | 479 | putStrLn "------ eig" |
503 | test (eigSHProp . rHer) | 480 | test (eigSHProp . rHer) |
@@ -515,10 +492,10 @@ runTests n = do | |||
515 | test (qrProp . rM) | 492 | test (qrProp . rM) |
516 | test (qrProp . cM) | 493 | test (qrProp . cM) |
517 | test (rqProp . rM) | 494 | test (rqProp . rM) |
518 | test (rqProp . cM) | 495 | -- test (rqProp . cM) |
519 | test (rqProp1 . cM) | 496 | test (rqProp1 . cM) |
520 | test (rqProp2 . cM) | 497 | test (rqProp2 . cM) |
521 | test (rqProp3 . cM) | 498 | -- test (rqProp3 . cM) |
522 | putStrLn "------ hess" | 499 | putStrLn "------ hess" |
523 | test (hessProp . rSq) | 500 | test (hessProp . rSq) |
524 | test (hessProp . cSq) | 501 | test (hessProp . cSq) |
@@ -539,12 +516,12 @@ runTests n = do | |||
539 | test (\u -> sin u ** 2 + cos u ** 2 |~| (1::RM)) | 516 | test (\u -> sin u ** 2 + cos u ** 2 |~| (1::RM)) |
540 | test (\u -> cos u * tan u |~| sin (u::RM)) | 517 | test (\u -> cos u * tan u |~| sin (u::RM)) |
541 | test $ (\u -> cos u * tan u |~| sin (u::CM)) . liftMatrix makeUnitary | 518 | test $ (\u -> cos u * tan u |~| sin (u::CM)) . liftMatrix makeUnitary |
542 | putStrLn "------ vector operations - Float" | 519 | -- putStrLn "------ vector operations - Float" |
543 | test (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::FM)) | 520 | -- test (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::FM)) |
544 | test $ (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::ZM)) . liftMatrix makeUnitary | 521 | -- test $ (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::ZM)) . liftMatrix makeUnitary |
545 | test (\u -> sin u ** 2 + cos u ** 2 |~~| (1::FM)) | 522 | -- test (\u -> sin u ** 2 + cos u ** 2 |~~| (1::FM)) |
546 | test (\u -> cos u * tan u |~~| sin (u::FM)) | 523 | -- test (\u -> cos u * tan u |~~| sin (u::FM)) |
547 | test $ (\u -> cos u * tan u |~~| sin (u::ZM)) . liftMatrix makeUnitary | 524 | -- test $ (\u -> cos u * tan u |~~| sin (u::ZM)) . liftMatrix makeUnitary |
548 | putStrLn "------ read . show" | 525 | putStrLn "------ read . show" |
549 | test (\m -> (m::RM) == read (show m)) | 526 | test (\m -> (m::RM) == read (show m)) |
550 | test (\m -> (m::CM) == read (show m)) | 527 | test (\m -> (m::CM) == read (show m)) |
@@ -562,8 +539,8 @@ runTests n = do | |||
562 | , utest "expm1" (expmTest1) | 539 | , utest "expm1" (expmTest1) |
563 | , utest "expm2" (expmTest2) | 540 | , utest "expm2" (expmTest2) |
564 | , utest "arith1" $ ((ones (100,100) * 5 + 2)/0.5 - 7)**2 |~| (49 :: RM) | 541 | , 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) | 542 | , 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 | 543 | , 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] | 544 | , utest "<\\>" $ (3><2) [2,0,0,3,1,1::Double] <\> 3|>[4,9,5] |~| 2|>[2,3] |
568 | -- , utest "gamma" (gamma 5 == 24.0) | 545 | -- , utest "gamma" (gamma 5 == 24.0) |
569 | -- , besselTest | 546 | -- , besselTest |
@@ -571,10 +548,10 @@ runTests n = do | |||
571 | , utest "randomGaussian" randomTestGaussian | 548 | , utest "randomGaussian" randomTestGaussian |
572 | , utest "randomUniform" randomTestUniform | 549 | , utest "randomUniform" randomTestUniform |
573 | , utest "buildVector/Matrix" $ | 550 | , utest "buildVector/Matrix" $ |
574 | complex (10 |> [0::Double ..]) == buildVector 10 fromIntegral | 551 | complex (10 |> [0::Double ..]) == build 10 id |
575 | && ident 5 == buildMatrix 5 5 (\(r,c) -> if r==c then 1::Double else 0) | 552 | && 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 | 553 | , 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 | 554 | && 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) | 555 | , utest "block" $ fromBlocks [[ident 3,0],[0,ident 4]] == (ident 7 :: CM) |
579 | , mbCholTest | 556 | , mbCholTest |
580 | , utest "offset" offsetTest | 557 | , utest "offset" offsetTest |
@@ -588,7 +565,6 @@ runTests n = do | |||
588 | , conformTest | 565 | , conformTest |
589 | , accumTest | 566 | , accumTest |
590 | , convolutionTest | 567 | , convolutionTest |
591 | , kroneckerTest | ||
592 | , sparseTest | 568 | , sparseTest |
593 | , staticTest | 569 | , staticTest |
594 | ] | 570 | ] |
@@ -597,12 +573,12 @@ runTests n = do | |||
597 | 573 | ||
598 | 574 | ||
599 | -- single precision approximate equality | 575 | -- single precision approximate equality |
600 | infixl 4 |~~| | 576 | -- infixl 4 |~~| |
601 | a |~~| b = a :~6~: b | 577 | -- a |~~| b = a :~6~: b |
602 | 578 | ||
603 | makeUnitary v | realPart n > 1 = v / scalar n | 579 | makeUnitary v | realPart n > 1 = v / scalar n |
604 | | otherwise = v | 580 | | otherwise = v |
605 | where n = sqrt (v <.> v) | 581 | where n = sqrt (v `dot` v) |
606 | 582 | ||
607 | -- -- | Some additional tests on big matrices. They take a few minutes. | 583 | -- -- | Some additional tests on big matrices. They take a few minutes. |
608 | -- runBigTests :: IO () | 584 | -- runBigTests :: IO () |
@@ -668,9 +644,9 @@ manyvec5 xs = sumElements $ fromRows $ map (\x -> vec3 x (x**2) (x**3)) xs | |||
668 | 644 | ||
669 | 645 | ||
670 | manyvec2 xs = sum $ map (\x -> sqrt(x^2 + (x**2)^2 +(x**3)^2)) xs | 646 | 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 | 647 | manyvec3 xs = sum $ map (norm_2 . (\x -> fromList [x,x**2,x**3])) xs |
672 | 648 | ||
673 | manyvec4 xs = sum $ map (pnorm PNorm2 . (\x -> vec3 x (x**2) (x**3))) xs | 649 | manyvec4 xs = sum $ map (norm_2 . (\x -> vec3 x (x**2) (x**3))) xs |
674 | 650 | ||
675 | vec3 :: Double -> Double -> Double -> Vector Double | 651 | vec3 :: Double -> Double -> Double -> Vector Double |
676 | vec3 a b c = runSTVector $ do | 652 | vec3 a b c = runSTVector $ do |
@@ -695,11 +671,11 @@ mkVecBench = do | |||
695 | 671 | ||
696 | subBench = do | 672 | subBench = do |
697 | putStrLn "" | 673 | putStrLn "" |
698 | let g = foldl1' (.) (replicate (10^5) (\v -> subVector 1 (dim v -1) v)) | 674 | 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) | 675 | time "0.1M subVector " (g (konst 1 (1+10^5) :: Vector Double) ! 0) |
700 | let f = foldl1' (.) (replicate (10^5) (fromRows.toRows)) | 676 | let f = foldl1' (.) (replicate (10^5) (fromRows.toRows)) |
701 | time "subVector-join 3" (f (ident 3 :: Matrix Double) @@>(0,0)) | 677 | time "subVector-join 3" (f (ident 3 :: Matrix Double) `atIndex` (0,0)) |
702 | time "subVector-join 10" (f (ident 10 :: Matrix Double) @@>(0,0)) | 678 | time "subVector-join 10" (f (ident 10 :: Matrix Double) `atIndex` (0,0)) |
703 | 679 | ||
704 | -------------------------------- | 680 | -------------------------------- |
705 | 681 | ||
@@ -724,7 +700,7 @@ multBench = do | |||
724 | 700 | ||
725 | eigBench = do | 701 | eigBench = do |
726 | let m = reshape 1000 (randomVector 777 Uniform (1000*1000)) | 702 | let m = reshape 1000 (randomVector 777 Uniform (1000*1000)) |
727 | s = m + trans m | 703 | s = m + tr m |
728 | m `seq` s `seq` putStrLn "" | 704 | m `seq` s `seq` putStrLn "" |
729 | time "eigenvalues symmetric 1000x1000" (eigenvaluesSH' m) | 705 | time "eigenvalues symmetric 1000x1000" (eigenvaluesSH' m) |
730 | time "eigenvectors symmetric 1000x1000" (snd $ eigSH' m) | 706 | time "eigenvectors symmetric 1000x1000" (snd $ eigSH' m) |
@@ -736,7 +712,7 @@ eigBench = do | |||
736 | svdBench = do | 712 | svdBench = do |
737 | let a = reshape 500 (randomVector 777 Uniform (3000*500)) | 713 | let a = reshape 500 (randomVector 777 Uniform (3000*500)) |
738 | b = reshape 1000 (randomVector 777 Uniform (1000*1000)) | 714 | b = reshape 1000 (randomVector 777 Uniform (1000*1000)) |
739 | fv (_,_,v) = v@@>(0,0) | 715 | fv (_,_,v) = v `atIndex` (0,0) |
740 | a `seq` b `seq` putStrLn "" | 716 | a `seq` b `seq` putStrLn "" |
741 | time "singular values 3000x500" (singularValues a) | 717 | time "singular values 3000x500" (singularValues a) |
742 | time "thin svd 3000x500" (fv $ thinSVD a) | 718 | time "thin svd 3000x500" (fv $ thinSVD a) |
@@ -748,7 +724,7 @@ svdBench = do | |||
748 | 724 | ||
749 | solveBenchN n = do | 725 | solveBenchN n = do |
750 | let x = uniformSample 777 (2*n) (replicate n (-1,1)) | 726 | let x = uniformSample 777 (2*n) (replicate n (-1,1)) |
751 | a = trans x <> x | 727 | a = tr x <> x |
752 | b = asColumn $ randomVector 666 Uniform n | 728 | b = asColumn $ randomVector 666 Uniform n |
753 | a `seq` b `seq` putStrLn "" | 729 | a `seq` b `seq` putStrLn "" |
754 | time ("svd solve " ++ show n) (linearSolveSVD a b) | 730 | time ("svd solve " ++ show n) (linearSolveSVD a b) |
@@ -765,7 +741,7 @@ solveBench = do | |||
765 | 741 | ||
766 | cholBenchN n = do | 742 | cholBenchN n = do |
767 | let x = uniformSample 777 (2*n) (replicate n (-1,1)) | 743 | let x = uniformSample 777 (2*n) (replicate n (-1,1)) |
768 | a = trans x <> x | 744 | a = tr x <> x |
769 | a `seq` putStr "" | 745 | a `seq` putStr "" |
770 | time ("chol " ++ show n) (chol a) | 746 | time ("chol " ++ show n) (chol a) |
771 | 747 | ||