# numeric-tools / test / test.hs

 ``` 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123``` ``` import Test.HUnit import Text.Printf import Numeric.Tools.Integration import Numeric.Tools.Differentiation import Numeric.Tools.Equation import Numeric.ApproxEq ---------------------------------------------------------------- -- Integration ---------------------------------------------------------------- -- Functions together with indefinite integral and list of ranges type FunctionInt = ( Double -> Double -- Function , Double -> Double -- Integral , [(Double,Double)] -- List of ranges , String -- Name ) -- Test integrator integratorTest :: String -> (QuadParam -> (Double,Double) -> (Double -> Double) -> QuadRes) -> QuadParam -> FunctionInt -> [Test] integratorTest name quad param (f,f',ranges,fname) = [ case quadRes \$ quad param (a,b) f of Nothing -> TestCase \$ assertFailure (printf "%s: convergence for %s failed (%f,%f)" name fname a b) Just appr -> let exact = f' b - f' a in TestCase \$ assertBool (printf "%s: poor convergence for %s (%f,%f) %g instead of %g" name fname a b appr exact) (eqRelative (quadPrecision param) exact appr) | (a,b) <- ranges ] testIntegration :: [Test] testIntegration = concat [ integratorTest "Trapeze" quadTrapezoid defQuad =<< [funBlamg,funExp,funLog] , integratorTest "Simpson" quadSimpson defQuad =<< [funBlamg,funExp,funLog] , integratorTest "Romberg" quadRomberg defQuad =<< [funBlamg,funExp,funLog] ] where funBlamg = ( \x -> x^4 * log(x + sqrt (x*x + 1)) , \x -> 1/5*x^5 * log(x + sqrt (x*x + 1)) - 1/75*sqrt(x*x+1)*(3*x^4 - 4*x^2 + 8) , [(0,2), (1,3), (-2,3)] , "x^4·log(x + sqrt(x^2 + 1))" ) funExp = ( exp, exp , [(0,2), (1,3), (-2,3)] , "exp" ) funLog = ( log , \x -> x * (log x - 1) , [(1,2), (0.3,3)] , "log" ) ---------------------------------------------------------------- -- ---------------------------------------------------------------- type FunctionDiff = ( Double -> Double -- Function , Double -> Double -- Derivative , [(Double,Double)] -- Points and delta to evaluate , String -- Name ) differentiationTest :: String -> ((Double -> Double) -> Double -> Double -> DiffRes) -> FunctionDiff -> [Test] differentiationTest name diff (f,f',xs,fname) = [ let DiffRes appr err = diff f h x exact = f' x in TestCase \$ assertBool (printf "%s: poor precision for %s, got %g instead of %g" name fname appr exact) (eqRelative 1e-13 appr exact) | (x,h) <- xs ] testDifferentiation :: [Test] testDifferentiation = concat [ differentiationTest "richardson" diffRichardson =<< [funSqr,funExp,funLog] ] where funSqr = ( \x -> x*x , \x -> 2*x , zip ([-10 .. -1]++[1..10]) (repeat 1) , "square" ) funExp = ( exp, exp , zip [-10..10] (repeat 1) , "exp" ) funLog = ( log, recip , map (\x -> (x,x/3)) [0.1,0.2 .. 2] , "log" ) testEquation :: [Test] testEquation = [ TestCase \$ assertBool "Bisection" \$ ok (pi/2) (solveBisection 0 (1,2) cos) , TestCase \$ assertBool "Ridders" \$ ok (pi/2) \$ solveRidders 0 (1,2) cos , TestCase \$ assertBool "Newton" \$ ok (pi/2) \$ solveNewton 0 (1,2) cos sin ] where ok exact (Root x) = within 1 exact x ok _ _ = False main :: IO () main = do res <- runTestTT \$ TestList \$ concat [ testDifferentiation , testIntegration , testEquation ] print res ```