exact-real 0.2.0.0 → 0.2.1.0

raw patch · 6 files changed

+87/−8 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• exact-real.cabal +2/−1
• src/Data/CReal/Internal.hs +19/−0
• test/Ord.hs +34/−0
• test/Test.hs +13/−1
• test/Test/QuickCheck/Classes/Extra.hs +16/−4
• test/Test/QuickCheck/Extra.hs +3/−2

@@ -1,5 +1,5 @@ name:                exact-real-version:             0.2.0.0+version:             0.2.1.0 synopsis:            Exact real arithmetic description:         please see readme.md license:             MIT@@ -42,6 +42,7 @@   other-modules:     Fractional,     Num,+    Ord,     Data.CReal.Extra,     Data.Monoid.Extra,     Test.QuickCheck.Classes.Extra

@@ -8,6 +8,9 @@   , atPrecision   , crealPrecision +  , shiftL+  , shiftR+   , (/.)   , log2   , log10@@ -117,10 +120,26 @@ instance KnownNat n => Ord (CReal n) where   compare x y = let p = crealPrecision x                 in compare ((x - y) `atPrecision` p) 0+  max (CR x) (CR y) = CR (\p -> max (x p) (y p))+  min (CR x) (CR y) = CR (\p -> min (x p) (y p))  -------------------------------------------------------------------------------- -- Some utility functions --------------------------------------------------------------------------------++--+-- Multiplication with powers of two+--++shiftR :: CReal n -> Int -> CReal n+shiftR (CR x) n = CR (\p -> let p' = p - n+                            in if p' >= 0+                                 then x p'+                                 else x 0 /. 2^(-p'))++shiftL :: CReal n -> Int -> CReal n+shiftL x = shiftR x . negate+  -- -- Showing CReals

@@ -0,0 +1,34 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Ord+  ( ord+  ) where++import Test.QuickCheck (Arbitrary)+import Test.QuickCheck.Checkers (EqProp)+import Test.QuickCheck.Classes.Extra (ordRel, complement)+import Test.Tasty.Extra (testGroup, TestTree, testTreeFromNamedBatch)+import Test.Tasty.QuickCheck (Gen, oneof, arbitrary, testProperty, property)++ord :: forall a. (Arbitrary a, Show a, EqProp a, Ord a) => a -> TestTree+ord _ = testGroup "Test Ord instance" ts+  where+    gen :: a -> Gen a+    gen x = oneof [pure x, arbitrary]+    ts = [ testTreeFromNamedBatch "<= is a total ordering" (ordRel (<=) gen)+         , testTreeFromNamedBatch ">= is a total ordering" (ordRel (>=) gen)+         , complement "< is the complement of >=" gen (<) (>=)+         , complement "> is the complement of <=" gen (>) (<=)+         , testProperty "max x y >= x xnd y" (property $ \x y ->+                               let m = max x y :: a+                               in m >= x && m >= y)+         , testProperty "max x y == x or y" (property $ \x y ->+                               let m = max x y :: a+                               in m == x || m == y)+         , testProperty "min x y >= x xnd y" (property $ \x y ->+                               let m = min x y :: a+                               in m <= x && m <= y)+         , testProperty "min x y == x or y" (property $ \x y ->+                               let m = min x y :: a+                               in m == x || m == y)+         ]

@@ -6,12 +6,13 @@  import Test.Tasty (testGroup, TestTree) import Test.Tasty.TH (defaultMainGenerator)-import Test.Tasty.QuickCheck (Arbitrary(..), Positive(..), testProperty, (===), Property)+import Test.Tasty.QuickCheck (Arbitrary(..), Positive(..), testProperty, (===), Property, NonNegative(..))  import Data.CReal.Internal import Data.CReal.Extra ()  import Fractional (fractional)+import Ord (ord)  -- How many binary digits to use for comparisons TODO: Test with many different -- precisions@@ -29,6 +30,10 @@ test_fractional :: [TestTree] test_fractional = [fractional (undefined :: CReal Precision)] +{-# ANN test_ord "HLint: ignore Use camelCase" #-}+test_ord :: [TestTree]+test_ord = [ ord (undefined :: CReal Precision) ]+ prop_decimalDigits :: Positive Int -> Bool prop_decimalDigits (Positive p) = let d = decimalDigitsAtPrecision p                                   in 10^d >= (2^p :: Integer) &&@@ -36,6 +41,13 @@  prop_showIntegral :: Integer -> Property prop_showIntegral i = show i === show (fromInteger i :: CReal 0)++-- TODO: Drop the NonNegative constraint when Floating is implemented and use **+prop_shiftL :: CReal Precision -> NonNegative Int -> Property+prop_shiftL x (NonNegative s) = x `shiftL` s === x * 2^s++prop_shiftR :: CReal Precision -> NonNegative Int -> Property+prop_shiftR x (NonNegative s) = x `shiftR` s === x / 2^s  main :: IO () main = $(defaultMainGenerator)

@@ -1,25 +1,29 @@ {-# LANGUAGE ScopedTypeVariables #-}  -- | Add a bunch of checkers for testing properties of different algebraic--- structures+-- structures and relations module Test.QuickCheck.Classes.Extra   ( module Test.QuickCheck.Classes+  -- | Algebraic structures   , group   , abelian   , ring   , commutativeRing   , field++  -- | Relations+  , complement   ) where  import Data.Group (invert, Group, Abelian) import Data.Monoid ((<>), Sum(..), Product) import Data.Monoid.Extra ()-import Test.QuickCheck.Extra (Arbitrary)+import Test.QuickCheck.Extra (Arbitrary, (<=>)) import Test.QuickCheck.Modifiers (NonZero)-import Test.QuickCheck.Checkers (commutes, EqProp, (=-=))+import Test.QuickCheck.Checkers (commutes, EqProp, (=-=), BinRel) import Test.QuickCheck.Classes import Test.Tasty.Extra (testGroup, TestTree, testTreeFromBatch, testTreeFromNamedBatch)-import Test.Tasty.QuickCheck (testProperty, Property)+import Test.Tasty.QuickCheck (testProperty, Property, Gen, property, forAll)  distributesL :: EqProp a => (a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> Property distributesL (*:) (+:) a b c = a *: (b +: c) =-= (a *: b) +: (a *: c)@@ -66,3 +70,11 @@               abelian "Abelian under Product NonZero" (undefined :: Product (NonZero a)),               distributes "* distributes over +" (*) ((+) :: a -> a -> a)] +complement :: forall a. (Arbitrary a, EqProp a, Show a, Ord a) =>+              String -> (a -> Gen a) -> BinRel a -> BinRel a -> TestTree+complement s gen r1 r2 = testGroup s ts+  where ts = [testProperty "strictOrd"+              (property $ \ a ->+               forAll (gen a) $ \ b ->+               a `r1` b <=> not (a `r2` b))+             ]

@@ -9,6 +9,7 @@   , UnitInterval(..)   , BiunitInterval(..)   , Tiny(..)+  , (<=>)   ) where  import Test.QuickCheck (Arbitrary(..), choose, suchThat)@@ -44,5 +45,5 @@ instance (Num a, Ord a, Arbitrary a) => Arbitrary (Tiny a) where   arbitrary = Tiny <$> arbitrary `suchThat` ((< tinyBound) . abs) --+(<=>) :: Bool -> Bool -> Bool+(<=>) = (==)