From cad18619075892000daa8ebe5a42d499ecebe9f5 Mon Sep 17 00:00:00 2001 From: Aleksey Khudyakov Date: Wed, 29 Aug 2012 19:12:02 +0400 Subject: [PATCH] Initial commit Core is taken from statistcs test suite --- .hgignore | 1 + LICENSE | 30 +++++++++++++ Setup.hs | 2 + Test/QuickCheck/Numeric.hs | 90 ++++++++++++++++++++++++++++++++++++++ quickcheck-numeric.cabal | 26 +++++++++++ 5 files changed, 149 insertions(+) create mode 100644 .hgignore create mode 100644 LICENSE create mode 100644 Setup.hs create mode 100644 Test/QuickCheck/Numeric.hs create mode 100644 quickcheck-numeric.cabal diff --git a/.hgignore b/.hgignore new file mode 100644 index 0000000..1521c8b --- /dev/null +++ b/.hgignore @@ -0,0 +1 @@ +dist diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..0161a4c --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) Aleksey Khudyakov + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Test/QuickCheck/Numeric.hs b/Test/QuickCheck/Numeric.hs new file mode 100644 index 0000000..19543d3 --- /dev/null +++ b/Test/QuickCheck/Numeric.hs @@ -0,0 +1,90 @@ +-- | Helper for writing tests for numeric code +module Test.QuickCheck.Numeric ( + -- * Approximate equality + eq + , eqC + -- * Function monotonicity + , Monotonicity(..) + , monotonicFunction + , monotonicFunctionIEEE + ) where + +import Data.Complex +import qualified Numeric.IEEE as IEEE + + + + +---------------------------------------------------------------- +-- Approximate equality +---------------------------------------------------------------- + +-- | Approximate equality for 'Double'. Doesn't work well for numbers +-- which are almost zero. +eq :: Double -- ^ Relative error + -> Double -> Double -> Bool +eq eps a b + | a == 0 && b == 0 = True + | otherwise = abs (a - b) <= eps * max (abs a) (abs b) + +-- | Approximate equality for 'Complex Double' +eqC :: Double -- ^ Relative error + -> Complex Double + -> Complex Double + -> Bool +eqC eps a@(ar :+ ai) b@(br :+ bi) + | a == 0 && b == 0 = True + | otherwise = abs (ar - br) <= eps * d + && abs (ai - bi) <= eps * d + where + d = max (realPart $ abs a) (realPart $ abs b) + + + +---------------------------------------------------------------- +-- Function monotonicity +---------------------------------------------------------------- + +-- | Function monotonicity type. +data Monotonicity + = StrictInc -- ^ Strictly increasing function + | MonotoneInc -- ^ Monotonically increasing function + | StrictDec -- ^ Strictly decreasing function + | MonotoneDec -- ^ Monotonically decreasing function + deriving (Show,Eq,Ord) + + +-- | Check that function is nondecreasing. For floating point number +-- it may give spurious failures so 'monotonicFunction' +-- should be used in this case. +monotonicFunction :: (Ord a, Ord b) => Monotonicity -> (a -> b) -> a -> a -> Bool +monotonicFunction cmp f x1 x2 + = f (min x1 x2) `op` f (max x1 x2) + where + op = case cmp of + StrictInc -> (< ) + MonotoneInc -> (<=) + StrictDec -> (> ) + MonotoneDec -> (>=) + +-- | Check that function is nondecreasing taking rounding errors into +-- account. This function makes no distinction between strictly +-- increasing function and monotonically increasing function since +-- distinction is pointless for floating point. +-- +-- In fact funstion is allowed to decrease less than one ulp in order +-- to guard againist problems with excess precision. On x86 FPU works +-- with 80-bit numbers but doubles are 64-bit so rounding happens +-- whenever values are moved from registers to memory +monotonicFunctionIEEE :: (Ord a, IEEE.IEEE b) => Monotonicity -> (a -> b) -> a -> a -> Bool +monotonicFunctionIEEE cmp f x1 x2 + = y1 `op` y2 + || abs (y1 - y2) < abs (y2 * IEEE.epsilon) + where + y1 = f (min x1 x2) + y2 = f (max x1 x2) + op = case cmp of + StrictInc -> (<=) + MonotoneInc -> (<=) + StrictDec -> (>=) + MonotoneDec -> (>=) diff --git a/quickcheck-numeric.cabal b/quickcheck-numeric.cabal new file mode 100644 index 0000000..0d9d96e --- /dev/null +++ b/quickcheck-numeric.cabal @@ -0,0 +1,26 @@ +Name: quickcheck-numeric +Version: 0.1 +Synopsis: Helpers for writing tests for numeric code +Description: + Helpers for writing tests for numeric code + +Cabal-Version: >= 1.6 +License: BSD3 +License-File: LICENSE +Author: Aleksey Khudyakov +Maintainer: Aleksey Khudyakov +Homepage: http://bitbucket.org/Shimuuar/quickcheck-numeric +Category: Data +Build-Type: Simple + +source-repository head + type: hg + location: http://bitbucket.org/Shimuuar/quickcheck-numeric + +Library + Ghc-options: -Wall + Build-Depends: + base >=3 && <5, + ieee754 >= 0.7.3 + Exposed-modules: + Test.QuickCheck.Numeric