exact-real 0.5.0.0 → 0.7.1.0

raw patch · 7 files changed

+181/−3 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• exact-real.cabal +12/−3
• src/Data/CReal/Internal.hs +42/−0
• stack.yaml +15/−0
• test/Read.hs +15/−0
• test/RealFloat.hs +42/−0
• test/RealFrac.hs +40/−0
• test/Test.hs +15/−0

@@ -1,17 +1,21 @@ name:                exact-real-version:             0.5.0.0+version:             0.7.1.0 synopsis:            Exact real arithmetic-description:         please see readme.md+description:+  A type to represent exact real number using a fast binary Cauchy sequence license:             MIT license-file:        LICENSE author:              Joe Hermaszewski-maintainer:          keep.it.real@monoid.al+maintainer:          Joe Hermaszewski <keep.it.real@monoid.al>+homepage:            http://github.com/expipiplus1/exact-real+bug-reports:         http://github.com/expipiplus1/exact-real/issues copyright:           2015 Joe Hermaszewski category:            Math build-type:          Simple extra-source-files:   .gitignore   readme.md+  stack.yaml cabal-version:       >=1.10  library@@ -47,7 +51,10 @@     Fractional,     Num,     Ord,+    Read,     Real,+    RealFloat,+    RealFrac,     Test.QuickCheck.Classes.Extra     Test.QuickCheck.Extra     Test.Tasty.Extra@@ -83,3 +90,5 @@ source-repository head   type: git   location: https://github.com/expipiplus1/exact-real++

@@ -42,6 +42,7 @@ import GHC.Base (Int(..)) import GHC.Integer.Logarithms (integerLog2#, integerLogBase#) import GHC.TypeLits+import Numeric (readSigned, readFloat)  -- $setup -- >>> :set -XDataKinds@@ -80,6 +81,9 @@ instance KnownNat n => Show (CReal n) where   show x = showAtPrecision (crealPrecision x) x +instance KnownNat n => Read (CReal n) where+  readsPrec _ = readSigned readFloat+ -- | @signum (x :: CReal p)@ returns the sign of @x@ at precision @p@. It's -- important to remember that this /may not/ represent the actual sign of @x@ if -- the distance between @x@ and zero is less than 2^-@p@.@@ -198,6 +202,44 @@ instance KnownNat n => Real (CReal n) where   toRational x = let p = crealPrecision x                  in x `atPrecision` p % 2^p++instance KnownNat n => RealFrac (CReal n) where+  properFraction x = let n = x `atPrecision` 0+                         f = x - fromIntegral n+                     in (fromInteger n, f)++-- | Several of the functions in this class ('floatDigits', 'floatRange',+-- 'exponent', 'significand') only make sense for floats represented by a+-- mantissa and exponent. These are bound to error.+--+-- @atan2 y x `atPrecision` p@ performs the comparison to determine the+-- quadrant at precision p. This can cause atan2 to be slightly slower than atan+instance KnownNat n => RealFloat (CReal n) where+  floatRadix _ = 2+  floatDigits _ = error "Data.CReal.Internal floatDigits"+  floatRange _ = error "Data.CReal.Internal floatRange"+  decodeFloat x = let p = crealPrecision x+                  in (x `atPrecision` p, -p)+  encodeFloat m n = fromRational (m % 2^(-n))+  exponent = error "Data.CReal.Internal exponent"+  significand = error "Data.CReal.Internal significand"+  scaleFloat = flip shiftL+  isNaN _ = False+  isInfinite _ = False+  isDenormalized _ = False+  isNegativeZero _ = False+  isIEEE _ = False+  atan2 y x = CR (\p ->+    let y' = y `atPrecision` p+        x' = x `atPrecision` p+        θ = if | x' > 0            ->  atan (y/x)+               | x' == 0 && y' > 0 ->  pi/2+               | x' <  0 && y' > 0 ->  pi + atan (y/x)+               | x' <= 0 && y' < 0 -> -atan2 (-y) x+               | y' == 0 && x' < 0 ->  pi    -- must be after the previous test on zero y+               | x'==0 && y'==0    ->  0     -- must be after the other double zero tests+               | otherwise         ->  error "Data.CReal.Internal atan2"+    in θ `atPrecision` p)  -- | Values of type @CReal p@ are compared for equality at precision @p@. This -- may cause values which differ by less than 2^-p to compare as equal.

@@ -0,0 +1,15 @@+# For more information, see: https://github.com/commercialhaskell/stack/blob/master/doc/yaml_configuration.md++# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)+resolver: lts-3.13++# Local packages, usually specified by relative directory name+packages:+- '.'++# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)+extra-deps: []++# Override default flag values for local packages and extra-deps+flags: {}+

@@ -0,0 +1,15 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Read+  ( read'+  ) where++import Test.QuickCheck.Checkers (EqProp, inverseL)+import Test.Tasty (testGroup, TestTree)+import Test.Tasty.QuickCheck (testProperty, Arbitrary)++read' :: forall a. (Arbitrary a, EqProp a, Show a, Read a) => a -> TestTree+read' _ = testGroup "Test Read instance" ts+  where ts = [ testProperty "read show left inverse"+                            (inverseL read (show :: a -> String))+             ]

@@ -0,0 +1,42 @@+{-# LANGUAGE ScopedTypeVariables #-}++module RealFloat+  ( realFloat+  ) where++import Data.Ratio.Extra ()+import Test.QuickCheck.Checkers (EqProp, (=-=), inverseL)+import Test.Tasty (testGroup, TestTree)+import Test.Tasty.QuickCheck (testProperty, Arbitrary, (==>))++realFloat :: forall a. (Arbitrary a, EqProp a, Show a, RealFloat a) =>+            a -> TestTree+realFloat x = testGroup "Test RealFloat instance" ts+  where ts = [ decodeFloatLaws "decodeFloat laws" x+             , testProperty "encodeFloat decodeFloat left inverse"+                            (inverseL (uncurry encodeFloat) (decodeFloat :: a -> (Integer, Int)))+             , testProperty "scaleFloat definition"+                            (\y i -> let r = floatRadix y+                                     in scaleFloat i (y::a) =-= y * fromIntegral r ^^ i)+             , atan2Laws "atan2 laws" x+             ]++decodeFloatLaws :: forall a. (Arbitrary a, EqProp a, Show a, RealFloat a) =>+                      String -> a -> TestTree+decodeFloatLaws s _ = testGroup s ts+  where ts = [ testProperty "x = m*b^^n"+                            (\x -> let (m, n) = decodeFloat (x :: a)+                                       b = floatRadix x+                                   in not (isNaN x || isInfinite x) ==>+                                      (x =-= fromInteger m * fromInteger b ^^ n))+             ]++atan2Laws :: forall a. (Arbitrary a, EqProp a, Show a, RealFloat a) =>+             String -> a -> TestTree+atan2Laws s _ = testGroup s ts+  where ts = [ testProperty "atan2 range" (\y x -> let θ = atan2 y (x :: a)+                                                   in abs θ <= pi)+             , testProperty "atan2 y 1 = atan y" (\y -> let θ = atan2 y (1 :: a)+                                                        in θ =-= atan y)+             ]+

@@ -0,0 +1,40 @@+{-# LANGUAGE ScopedTypeVariables #-}++module RealFrac+  ( realFrac+  ) where++import Data.Ratio.Extra ()+import Test.QuickCheck.Checkers (EqProp, (=-=))+import Test.Tasty (testGroup, TestTree)+import Test.Tasty.QuickCheck (testProperty, Arbitrary)++-- TODO: Test the other functions+realFrac :: forall a. (Arbitrary a, EqProp a, Show a, RealFrac a) =>+            a -> TestTree+realFrac x = testGroup "Test RealFrac instance" ts+  where ts = [ properFractionLaws "properFraction laws" x ]++-- | This tests a slightly different law for n having the same sign as x+properFractionLaws :: forall a. (Arbitrary a, EqProp a, Show a, RealFrac a) =>+                      String -> a -> TestTree+properFractionLaws s _ = testGroup s ts+  where ts = [ testProperty "x = n + f"+                            (\x -> let (n, f) = properFraction (x :: a)+                                   in x =-= fromInteger n + f)+             , testProperty "n has same sign or is zero"+                            (\x -> let (n, _) = properFraction (x :: a)+                                   in n == 0 || sign x == sign (n::Int))+             , testProperty "abs f < 1"+                            (\x -> let (_::Int, f) = properFraction (x :: a)+                                   in abs f < 1)+             ]++data Sign = Positive+          | Negative+  deriving (Eq, Show)++-- | Note that this returns Positive on zero rather than 0 like signum+sign :: (Ord a, Num a) => a -> Sign+sign x = if x < 0 then Negative+                  else Positive

@@ -14,7 +14,10 @@  import Floating (floating) import Ord (ord)+import Read (read') import Real (real)+import RealFrac (realFrac)+import RealFloat (realFloat)  -- How many binary digits to use for comparisons TODO: Test with many different -- precisions@@ -36,6 +39,18 @@ {-# ANN test_real "HLint: ignore Use camelCase" #-} test_real :: [TestTree] test_real = [ real (\x -> 1 % toInteger (crealPrecision (x::CReal Precision))) ]++{-# ANN test_realFrac "HLint: ignore Use camelCase" #-}+test_realFrac :: [TestTree]+test_realFrac = [ realFrac (undefined :: CReal Precision) ]++{-# ANN test_realFloat "HLint: ignore Use camelCase" #-}+test_realFloat :: [TestTree]+test_realFloat = [ realFloat (undefined :: CReal Precision) ]++{-# ANN test_read "HLint: ignore Use camelCase" #-}+test_read :: [TestTree]+test_read = [ read' (undefined :: CReal Precision) ]  prop_decimalDigits :: Positive Int -> Bool prop_decimalDigits (Positive p) = let d = decimalDigitsAtPrecision p