summaryrefslogtreecommitdiff
path: root/packages/tests/src/Numeric/LinearAlgebra/Tests.hs
diff options
context:
space:
mode:
Diffstat (limited to 'packages/tests/src/Numeric/LinearAlgebra/Tests.hs')
-rw-r--r--packages/tests/src/Numeric/LinearAlgebra/Tests.hs191
1 files changed, 92 insertions, 99 deletions
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
31import Numeric.LinearAlgebra 31import Numeric.LinearAlgebra.HMatrix
32import Numeric.LinearAlgebra.HMatrix hiding ((<>),linearSolve) 32import Numeric.LinearAlgebra.Devel hiding (vec)
33import Numeric.LinearAlgebra.Util hiding (ones)
33import Numeric.LinearAlgebra.Static(L) 34import Numeric.LinearAlgebra.Static(L)
34import Numeric.LinearAlgebra.Util(col,row)
35import Data.Packed
36import Numeric.LinearAlgebra.LAPACK
37import Numeric.LinearAlgebra.Tests.Instances 35import Numeric.LinearAlgebra.Tests.Instances
38import Numeric.LinearAlgebra.Tests.Properties 36import Numeric.LinearAlgebra.Tests.Properties
39import Test.HUnit hiding ((~:),test,Testable,State) 37import Test.HUnit hiding ((~:),test,Testable,State)
@@ -44,20 +42,16 @@ import qualified Prelude
44import System.CPUTime 42import System.CPUTime
45import System.Exit 43import System.Exit
46import Text.Printf 44import Text.Printf
47import Data.Packed.Development(unsafeFromForeignPtr,unsafeToForeignPtr) 45import Numeric.LinearAlgebra.Devel(unsafeFromForeignPtr,unsafeToForeignPtr)
48import Control.Arrow((***)) 46import Control.Arrow((***))
49import Debug.Trace 47import Debug.Trace
50import Control.Monad(when) 48import Control.Monad(when)
51import Numeric.LinearAlgebra.Util hiding (ones,row,col)
52import Control.Applicative 49import Control.Applicative
53import Control.Monad(ap) 50import Control.Monad(ap)
54 51
55import Data.Packed.ST
56
57import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector 52import 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)
60import qualified Test.QuickCheck as T
61 55
62import Test.QuickCheck.Test(isSuccess) 56import 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
95detTest2 = inv1 |~| inv2 && [det1] ~~ [det2] 89detTest2 = 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
146randomTestUniform = c :~1~: snd (meanCov dat) where 140randomTestUniform = c :~1~: snd (meanCov dat) where
@@ -174,51 +168,51 @@ offsetTest = y == y' where
174 168
175normsVTest = TestList [ 169normsVTest = 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
200normsMTest = TestList [ 194normsMTest = 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
253conjuTest m = mapVector conjugate (flatten (trans m)) == flatten (ctrans m) 247conjuTest 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
309successive_ 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)
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
318successive 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)
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
419runTests :: Int -- ^ maximum dimension 413runTests :: Int -- ^ maximum dimension
420 -> IO () 414 -> IO ()
421runTests n = do 415runTests 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
603makeUnitary v | realPart n > 1 = v / scalar n 596makeUnitary 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
670manyvec2 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
671manyvec3 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
672 665
673manyvec4 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
674 667
675vec3 :: Double -> Double -> Double -> Vector Double 668vec3 :: Double -> Double -> Double -> Vector Double
676vec3 a b c = runSTVector $ do 669vec3 a b c = runSTVector $ do
@@ -695,11 +688,11 @@ mkVecBench = do
695 688
696subBench = do 689subBench = 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
725eigBench = do 718eigBench = 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
736svdBench = do 729svdBench = 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
749solveBenchN n = do 742solveBenchN 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
766cholBenchN n = do 759cholBenchN 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