Merge pull request #140 from peddie/unittests

Unit tests for interpolation and simulated annealing modules

2 files changed, 61 insertions, 2 deletions

diff --git a/packages/tests/src/Numeric/GSL/Tests.hs b/packages/tests/src/Numeric/GSL/Tests.hs
index e5d205d..025427b 100644
--- a/packages/tests/src/Numeric/GSL/Tests.hs
+++ b/packages/tests/src/Numeric/GSL/Tests.hs
@@ -21,8 +21,9 @@ import Test.HUnit (runTestTT, failures, Test(..), errors)
 
 import Numeric.LinearAlgebra.HMatrix
 import Numeric.GSL
+import Numeric.GSL.SimulatedAnnealing
 import Numeric.LinearAlgebra.Tests (qCheck, utest)
-import Numeric.LinearAlgebra.Tests.Properties ((|~|), (~~))
+import Numeric.LinearAlgebra.Tests.Properties ((|~|), (~~), (~=))
 
 ---------------------------------------------------------------------
 
@@ -66,6 +67,59 @@ rootFindingTest = TestList [ utest "root Hybrids" (fst sol1 ~~ [1,1])
           jacobian a b [x,_y] = [ [-a    , 0]
                                 , [-2*b*x, b] ]
 
+--------------------------------------------------------------------
+
+interpolationTest = TestList [
+    utest "interpolation evaluateV" (esol ~= ev)
+  , utest "interpolation evaluate" (esol ~= eval)
+  , utest "interpolation evaluateDerivativeV" (desol ~= dev)
+  , utest "interpolation evaluateDerivative" (desol ~= de)
+  , utest "interpolation evaluateDerivative2V" (d2esol ~= d2ev)
+  , utest "interpolation evaluateDerivative2" (d2esol ~= d2e)
+  , utest "interpolation evaluateIntegralV" (intesol ~= intev)
+  , utest "interpolation evaluateIntegral" (intesol ~= inte)
+  ]
+  where
+    xtest = 2.2
+    applyVec f = f Akima xs ys xtest
+    applyList f = f Akima (zip xs' ys') xtest
+
+    esol = xtest**2
+    ev = applyVec evaluateV
+    eval = applyList evaluate
+
+    desol = 2*xtest
+    dev = applyVec evaluateDerivativeV
+    de = applyList evaluateDerivative
+
+    d2esol = 2
+    d2ev = applyVec evaluateDerivative2V
+    d2e = applyList evaluateDerivative2
+
+    intesol = 1/3 * xtest**3
+    intev = evaluateIntegralV Akima xs ys 0 xtest
+    inte = evaluateIntegral Akima (zip xs' ys') (0, xtest)
+
+    xs' = [-1..10]
+    ys' = map (**2) xs'
+    xs = vector xs'
+    ys = vector ys'
+
+---------------------------------------------------------------------
+
+simanTest = TestList [
+  -- We use a slightly more relaxed tolerance here because the
+  -- simulated annealer is randomized
+  utest "simulated annealing manual example" $ abs (result - 1.3631300) < 1e-6
+  ]
+  where
+    -- This is the example from the GSL manual.
+    result = simanSolve 0 1 exampleParams 15.5 exampleE exampleM exampleS Nothing
+    exampleParams = SimulatedAnnealingParams 200 10000 1.0 1.0 0.008 1.003 2.0e-6
+    exampleE x = exp (-(x - 1)**2) * sin (8 * x)
+    exampleM x y = abs $ x - y
+    exampleS rands stepSize current = (rands ! 0) * 2 * stepSize - stepSize + current
+
 ---------------------------------------------------------------------
 
 minimizationTest = TestList
@@ -123,6 +177,8 @@ runTests n = do
         , odeTest
         , rootFindingTest
         , minimizationTest
+        , interpolationTest
+        , simanTest
         , utest "deriv" derivTest
         , utest "integrate" (abs (volSphere 2.5 - 4/3*pi*2.5**3) < 1E-8)
         , utest "polySolve" (polySolveProp [1,2,3,4])
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs
index 720b7bd..046644f 100644
--- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs
+++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs
@@ -14,7 +14,7 @@ Testing properties.
 -}
 
 module Numeric.LinearAlgebra.Tests.Properties (
-    dist, (|~|), (~~), (~:), Aprox((:~)),
+    dist, (|~|), (~~), (~:), Aprox((:~)), (~=),
     zeros, ones,
     square,
     unitary,
@@ -45,6 +45,9 @@ module Numeric.LinearAlgebra.Tests.Properties (
 import Numeric.LinearAlgebra.HMatrix hiding (Testable,unitary)
 import Test.QuickCheck
 
+(~=) :: Double -> Double -> Bool
+a ~= b = abs (a - b) < 1e-10
+
 trivial :: Testable a => Bool -> a -> Property
 trivial = (`classify` "trivial")