Commits

Aleksey Khudyakov committed 474f81f

use approximate equality

  • Participants
  • Parent commits 264e3bc
  • Tags histogram-fill-binary-v0.6.2.1

Comments (0)

Files changed (1)

histogram-fill-tests/Test/Histogram.hs

   , testProperty "Bins value" $ prop_sliceBinVal t
   ]
 
-testMergeBin :: ( Show b, Typeable b, MergeableBin b, Arbitrary b, Bin1D b
+testMergeBin :: ( Show b, Typeable b, MergeableBin b, Arbitrary b, Bin1D b, AEq (BinValue b)
                 ) => T b -> TestTree
 testMergeBin t
   = testGroup ("Merge tests for " ++ show (typeOfT t))
   return (i,j)
 
 -- Check that merge works properly
-prop_Merge :: (MergeableBin b, Bin1D b, Show b)
+prop_Merge :: (MergeableBin b, AEq (BinValue b), Bin1D b, Show b)
            => T b -> b -> Property
 prop_Merge _ bin0 = do
   n   <- choose (1, nBins bin0)
   printTestCase     ("N = " ++ show n)
     $ printTestCase (case dir of { CutLower-> "CutLower"; CutHigher -> "CutHigher"})
     $ printTestCase (show bin)
-    $ lim bin   == lim bin0
+    $ lim bin   ~= lim bin0
    && nBins bin == (nBins bin0 `div` n)
 
 
 
 typeOfT :: Typeable a => T a -> TypeRep
 typeOfT = typeOf . paramOfT
+
+class AEq a where
+  (~=) :: a -> a -> Bool
+
+instance AEq Float where
+  x ~= y = abs (x - y) < 1e-4 * max (abs x) (abs y)
+
+instance AEq Double where
+  x ~= y = abs (x - y) < 1e-12 * max (abs x) (abs y)
+
+instance AEq Int where
+  (~=) = (==)
+