old tests passed

1 files changed, 121 insertions, 0 deletions

diff --git a/examples/oldtests.hs b/examples/oldtests.hs
new file mode 100644
index 0000000..987ef98
--- /dev/null
+++ b/examples/oldtests.hs
@@ -0,0 +1,121 @@
+import Test.HUnit
+
+import GSL
+import GSL.Matrix
+import System.Random(randomRs,mkStdGen)
+
+realMatrix = fromLists :: [[Double]] -> Matrix Double
+realVector = fromList ::  [Double] -> Vector Double
+
+toComplexM = uncurry $ liftMatrix2 (curry toComplex)
+
+infixl 2 =~=
+a =~= b = pnorm PNorm1 (flatten (a - b)) < 1E-6
+
+randomMatrix seed (n,m) = reshape m $ realVector $ take (n*m) $ randomRs (-100,100) $ mkStdGen seed 
+
+randomMatrixC seed (n,m) = toComplexM (randomMatrix seed (n,m), randomMatrix (seed+1) (n,m))
+
+besselTest = do
+    let (r,e) = bessel_J0_e 5.0
+    let expected = -0.17759677131433830434739701
+    assertBool "bessel_J0_e" ( abs (r-expected) < e ) 
+
+exponentialTest = do
+    let (v,e,err) = exp_e10_e 30.0
+    let expected = exp 30.0
+    assertBool "exp_e10_e" ( abs (v*10^e - expected) < 4E-2 ) 
+
+disp m = putStrLn (format " " show m)
+
+ms = realMatrix [[1,2,3]
+                ,[-4,1,7]]
+
+ms' = randomMatrix 27 (50,100)
+
+ms'' = toComplexM (randomMatrix 100 (50,100),randomMatrix 101 (50,100))
+
+fullsvdTest method mat msg = do
+    let (u,s,vt) = method mat
+    assertBool msg (u <> s <> trans vt =~= mat)
+
+svdg' m = (u, diag s, v) where (u,s,v) = svdg m
+
+full_svd_Rd = svdRdd
+
+--------------------------------------------------------------------
+
+mcu = toComplexM (randomMatrix 33 (20,20),randomMatrix 34 (20,20))
+
+mcur = randomMatrix 35 (40,40)
+
+-- eigenvectors are columns
+eigTest method m msg = do
+    let (s,v) = method m
+    assertBool msg $ m <> v =~= v <> diag s
+
+bigmat = m + trans m where m = randomMatrix 18 (1000,1000)
+bigmatc = mc + conjTrans mc where mc = toComplexM(m,m)
+                                  m = randomMatrix 19 (1000,1000)
+
+--------------------------------------------------------------------
+
+invTest msg m = do
+    assertBool msg $ m <> inv m =~= ident (rows m)
+
+invComplexTest msg m = do
+    assertBool msg $ m <> invC m =~= ident (rows m)
+
+invC m = linearSolveC m (ident (rows m))
+
+--identC n = toComplexM(ident n, (0::Double) <>ident n)
+
+--------------------------------------------------------------------
+
+pinvTest f msg m = do
+    assertBool msg $ m <> f m <> m =~= m
+
+pinvC m = linearSolveLSC m (ident (rows m))
+
+pinvSVDR m = linearSolveSVDR Nothing m (ident (rows m))
+
+pinvSVDC m = linearSolveSVDC Nothing m (ident (rows m))
+
+--------------------------------------------------------------------
+
+
+tests = TestList [
+      TestCase $ besselTest
+    , TestCase $ exponentialTest
+    , TestCase $ invTest "inv 100x100" (randomMatrix 18 (100,100))
+    , TestCase $ invComplexTest "complex inv 100x100" (randomMatrixC 18 (100,100))
+    , TestCase $ pinvTest (pinvTolg 1) "pinvg 100x50" (randomMatrix 18 (100,50))
+    , TestCase $ pinvTest pinv "pinv 100x50" (randomMatrix 18 (100,50))
+    , TestCase $ pinvTest pinv "pinv 50x100" (randomMatrix 18 (50,100))
+    , TestCase $ pinvTest pinvSVDR "pinvSVDR 100x50" (randomMatrix 18 (100,50))
+    , TestCase $ pinvTest pinvSVDR "pinvSVDR 50x100" (randomMatrix 18 (50,100))
+    , TestCase $ pinvTest pinvC "pinvC 100x50" (randomMatrixC 18 (100,50))
+    , TestCase $ pinvTest pinvC "pinvC 50x100" (randomMatrixC 18 (50,100))
+    , TestCase $ pinvTest pinvSVDC "pinvSVDC 100x50" (randomMatrixC 18 (100,50))
+    , TestCase $ pinvTest pinvSVDC "pinvSVDC 50x100" (randomMatrixC 18 (50,100))
+    , TestCase $ eigTest eigC mcu "eigC" 
+    , TestCase $ eigTest eigR mcur "eigR"
+    , TestCase $ eigTest eigS (mcur+trans mcur) "eigS"
+    , TestCase $ eigTest eigSg (mcur+trans mcur) "eigSg"
+    , TestCase $ eigTest eigH (mcu+ (conjTrans) mcu) "eigH"
+    , TestCase $ eigTest eigHg (mcu+ (conjTrans) mcu) "eigHg"
+    , TestCase $ fullsvdTest svdg' ms "GSL svd small"
+    , TestCase $ fullsvdTest svdR ms "fullsvdR small"
+    , TestCase $ fullsvdTest svdR (trans ms) "fullsvdR small"
+    , TestCase $ fullsvdTest svdR ms' "fullsvdR"
+    , TestCase $ fullsvdTest svdR (trans ms') "fullsvdR"
+    , TestCase $ fullsvdTest full_svd_Rd ms' "fullsvdRd"
+    , TestCase $ fullsvdTest full_svd_Rd (trans ms') "fullsvdRd"
+    , TestCase $ fullsvdTest svdC ms'' "fullsvdC"
+    , TestCase $ fullsvdTest svdC (trans ms'') "fullsvdC"
+    , TestCase $ eigTest eigS bigmat "big eigS"
+    , TestCase $ eigTest eigH bigmatc "big eigH"
+    , TestCase $ eigTest eigR bigmat "big eigR"
+    ]
+
+main = runTestTT tests