Decimal 0.2.3 → 0.3.1

raw patch · 4 files changed

+240/−144 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Decimal.cabal +5/−5
• README.txt +11/−2
• src/Data/Decimal.hs +54/−134
• tests/Main.hs +170/−3

@@ -1,8 +1,8 @@ Name:                Decimal-Version:             0.2.3+Version:             0.3.1 License:             BSD3 License-file:        LICENSE.txt-Copyright:           Paul Johnson, 2011+Copyright:           Paul Johnson, 2013 Author:              Paul Johnson Maintainer:          paul@cogito.org.uk Stability:           beta@@ -14,13 +14,13 @@                     exponent.  The exponent can be interpreted as the number                     of decimal places in the value. Extra-source-files:  README.txt-tested-with:         GHC==7.0.4+tested-with:         GHC==7.4.2+homepage:            https://github.com/PaulJohnson/Haskell-Decimal  library    build-depends:                         base >= 4 && < 5,-                    deepseq,-                    QuickCheck >= 2.4+                    deepseq   hs-source-dirs:   src   if impl(ghc >= 7.0.0)      default-language: Haskell2010

@@ -21,8 +21,7 @@ ------------------------  Data.Decimal includes a set of QuickCheck properties which act as both-tests and a formal specification (hence their inclusion in the Haddock-documentation).  To run the tests do:+tests and a formal specification. To run the tests do:     cabal configure --enable-tests    cabal build@@ -48,3 +47,13 @@  Added instance of NFData from Control.DeepSeq, and hence a dependency on the deepseq package, thanks to Jeff Shaw (shawjef3 at msu.edu).++Version 0.3.1+-------------++Added Typeable, Fractional and RealFrac instances.+Multiplication now returns an exact result, increasing precision if necessary.++These changes alter the API. Hence the increment to the major version number.++Thanks to Alexey Uimanov (s9gf4ult at gmail.com).

@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveDataTypeable #-}+ -- | Decimal numbers are represented as @m*10^(-e)@ where -- @m@ and @e@ are integers.  The exponent @e@ is an unsigned Word8.  Hence -- the smallest value that can be represented is @10^-255@.@@ -27,27 +29,16 @@    (*.),    divide,    allocate,-   -- ** QuickCheck Properties-   prop_readShow,-   prop_readShowPrecision,-   prop_fromIntegerZero,-   prop_increaseDecimals,-   prop_decreaseDecimals,-   prop_inverseAdd,-   prop_repeatedAdd,-   prop_divisionParts,-   prop_divisionUnits,-   prop_allocateParts,-   prop_allocateUnits,-   prop_abs,-   prop_signum+   eitherFromRational,+   normalizeDecimal, ) where +import Control.Monad.Instances () import Control.DeepSeq import Data.Char import Data.Ratio import Data.Word-import Test.QuickCheck+import Data.Typeable import Text.ParserCombinators.ReadP  -- | Raw decimal arithmetic type constructor.  A decimal value consists of an@@ -69,6 +60,7 @@ data (Integral i) => DecimalRaw i = Decimal {       decimalPlaces :: ! Word8,       decimalMantissa :: ! i}+                                  deriving (Typeable)   -- | Arbitrary precision decimal type.  As a rule programs should do decimal@@ -159,9 +151,8 @@         where (e, n1, n2) = roundMax d1 d2     d1 - d2 = Decimal e $ fromIntegral (n1 - n2)         where (e, n1, n2) = roundMax d1 d2-    d1 * d2 = Decimal e $ fromIntegral $ -              (n1 * n2) `divRound` (10 ^ e)-        where (e, n1, n2) = roundMax d1 d2+    d1 * d2 = normalizeDecimal $ realFracToDecimal maxBound $ (toRational d1) * (toRational d2)+     abs (Decimal e n) = Decimal e $ abs n     signum (Decimal _ n) = fromIntegral $ signum n     fromInteger n = Decimal 0 $ fromIntegral n@@ -169,16 +160,16 @@ instance (Integral i) => Real (DecimalRaw i) where     toRational (Decimal e n) = fromIntegral n % (10 ^ e) -instance (Integral i, Arbitrary i) => Arbitrary (DecimalRaw i) where-    arbitrary = do-      e <- sized (\n -> resize (n `div` 10) arbitrary) :: Gen Int-      m <- sized (\n -> resize (n * 10) arbitrary)-      return $ Decimal (fromIntegral $ abs e) m-      -instance (Integral i, Arbitrary i) => CoArbitrary (DecimalRaw i) where-    coarbitrary (Decimal e m) gen = variant (v:: Integer) gen-       where v = fromIntegral e + fromIntegral m+instance (Integral i) => Fractional (DecimalRaw i) where+  fromRational r = normalizeDecimal $ realFracToDecimal maxBound r+  a / b = fromRational $ (toRational a) / (toRational b) +instance (Integral i) => RealFrac (DecimalRaw i) where+  properFraction a = (rnd, fromRational rep)+    where+      (rnd, rep) = properFraction $ toRational a+      +    -- | Divide a @DecimalRaw@ value into one or more portions.  The portions -- will be approximately equal, and the sum of the portions is guaranteed to@@ -226,112 +217,41 @@ (*.) :: (Integral i, RealFrac r) => DecimalRaw i -> r -> DecimalRaw i (Decimal e m) *. d = Decimal e $ round $ fromIntegral m * d ---- | "read" is the inverse of "show".--- --- > read (show n) == n-prop_readShow :: Decimal -> Bool-prop_readShow d =  read (show d) == d---- | Read and show preserve decimal places.--- --- > decimalPlaces (read (show n)) == decimalPlaces n-prop_readShowPrecision :: Decimal -> Bool-prop_readShowPrecision d =  decimalPlaces (read (show d) :: Decimal) -                            == decimalPlaces d----- | "fromInteger" definition.--- --- > decimalPlaces (fromInteger n) == 0 &&--- > decimalMantissa (fromInteger n) == n-prop_fromIntegerZero :: Integer -> Bool-prop_fromIntegerZero n =  decimalPlaces (fromInteger n :: Decimal) == 0 &&-                          decimalMantissa (fromInteger n :: Decimal) == n----- | Increased precision does not affect equality.--- --- > decimalPlaces d < maxBound ==> roundTo (decimalPlaces d + 1) d == d-prop_increaseDecimals :: Decimal -> Property-prop_increaseDecimals d =  -    decimalPlaces d < maxBound ==> roundTo (decimalPlaces d + 1) d == d----- | Decreased precision can make two decimals equal, but it can never change--- their order.--- --- > forAll d1, d2 :: Decimal -> legal beforeRound afterRound--- >      where--- >         beforeRound = compare d1 d2--- >         afterRound = compare (roundTo 0 d1) (roundTo 0 d2)--- >         legal GT x = x `elem` [GT, EQ]--- >         legal EQ x = x `elem` [EQ]--- >         legal LT x = x `elem` [LT, EQ]-prop_decreaseDecimals :: Decimal -> Decimal -> Bool-prop_decreaseDecimals d1 d2 =  legal beforeRound afterRound-    where-      beforeRound = compare d1 d2-      afterRound = compare (roundTo 0 d1) (roundTo 0 d2)-      legal GT x = x `elem` [GT, EQ]-      legal EQ x = x `elem` [EQ]-      legal LT x = x `elem` [LT, EQ]----- | > (x + y) - y == x-prop_inverseAdd :: Decimal -> Decimal -> Bool-prop_inverseAdd x y =  (x + y) - y == x----- | Multiplication is repeated addition.--- --- > forall d, NonNegative i : (sum $ replicate i d) == d * fromIntegral (max i 0)-prop_repeatedAdd :: Decimal -> Word8 -> Bool-prop_repeatedAdd d i = (sum $ replicate (fromIntegral i) d) == d * fromIntegral (max i 0)----- | Division produces the right number of parts.--- --- > forall d, Positive i : (sum $ map fst $ divide d i) == i-prop_divisionParts :: Decimal -> Positive Int -> Property-prop_divisionParts d (Positive i) =  i > 0 ==> (sum $ map fst $ divide d i) == i----- | Division doesn't drop any units.--- --- > forall d, Positive i : (sum $ map (\(n,d1) -> fromIntegral n * d1) $ divide d i) == d-prop_divisionUnits :: Decimal -> Positive Int -> Bool-prop_divisionUnits d (Positive i) = -    (sum $ map (\(n,d1) -> fromIntegral n * d1) $ divide d i) == d----- | Allocate produces the right number of parts.--- --- > sum ps /= 0  ==>  length ps == length (allocate d ps)-prop_allocateParts :: Decimal -> [Integer] -> Property-prop_allocateParts d ps =  -    sum ps /= 0 ==> length ps == length (allocate d ps)----- | Allocate doesn't drop any units.--- --- >     sum ps /= 0  ==>  sum (allocate d ps) == d-prop_allocateUnits :: Decimal -> [Integer] -> Property-prop_allocateUnits d ps =-    sum ps /= 0 ==> sum (allocate d ps) == d+-- | Count the divisors, i.e. the count of 2 divisors in 18 is 1 because 18 = 2 * 3 * 3+factorN :: (Integral a)+           => a                  -- ^ Denominator base+           -> a                  -- ^ dividing value+           -> (a, a)             -- ^ The count of divisors and the result of division+factorN d val = factorN' val 0+  where+    factorN' 1 acc = (acc, 1)+    factorN' v acc = if md == 0+                     then factorN' vd (acc + 1)+                     else (acc, v)+      where+        (vd, md) = v `divMod` d --- | Absolute value definition--- --- > decimalPlaces a == decimalPlaces d && --- > decimalMantissa a == abs (decimalMantissa d)--- >    where a = abs d-prop_abs :: Decimal -> Bool-prop_abs d =  decimalPlaces a == decimalPlaces d && -              decimalMantissa a == abs (decimalMantissa d)-    where a = abs d+-- | Try to convert Rational to Decimal with absolute precision+-- return string with fail description if not converted+eitherFromRational :: (Integral i) => Rational -> Either String (DecimalRaw i)+eitherFromRational r = if done == 1+                       then do+                         wres <- we+                         return $ Decimal wres (fromIntegral m)+                       else Left $ show r ++ " has no decimal denominator"+  where+    den = denominator r+    num = numerator r+    (f2, rest) = factorN 2 den+    (f5, done) = factorN 5 rest+    e = max f2 f5+    m = num * ((10^e) `div` den)+    we = if e > (fromIntegral (maxBound :: Word8)) --  FIXME: will fail if DecimalRaw changed+         then Left $ show e ++ " is too big ten power to represent as Decimal"+         else Right $ fromIntegral e --- | Sign number defintion--- --- > signum d == (fromInteger $ signum $ decimalMantissa d)-prop_signum :: Decimal -> Bool-prop_signum d =  signum d == (fromInteger $ signum $ decimalMantissa d)+-- | Reduce the exponent of the decimal numer to the minimal posible value+normalizeDecimal :: (Integral i) => (DecimalRaw i) -> (DecimalRaw i)+normalizeDecimal r = case eitherFromRational $ toRational r of+  Right x -> x+  Left e -> error $ "Imposible happened: " ++ e

@@ -4,15 +4,175 @@ import Data.Ratio import Data.Word import Test.HUnit--+import Control.Applicative +import Test.QuickCheck+import qualified Test.QuickCheck.Property as P import Test.Framework as TF (defaultMain, testGroup, Test) import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 (testProperty)  +instance (Integral i, Arbitrary i) => Arbitrary (DecimalRaw i) where+  arbitrary = Decimal <$> arbitrary <*> arbitrary+  -- arbitrary = do +  --   e <- sized (\n -> resize (n `div` 10) arbitrary) :: Gen Int+  --   m <- sized (\n -> resize (n * 10) arbitrary)+  --   return $ Decimal (fromIntegral $ abs e) m+      +instance (Integral i, Arbitrary i) => CoArbitrary (DecimalRaw i) where+    coarbitrary (Decimal e m) gen = variant (v:: Integer) gen+       where v = fromIntegral e + fromIntegral m+  +-- | "read" is the inverse of "show".+-- +-- > read (show n) == n+prop_readShow :: Decimal -> Bool+prop_readShow d =  (read (show d)) == d +-- | Read and show preserve decimal places.+-- +-- > decimalPlaces (read (show n)) == decimalPlaces n+prop_readShowPrecision :: Decimal -> Bool+prop_readShowPrecision d =  decimalPlaces (read (show d) :: Decimal) +                            == decimalPlaces d+++-- | "fromInteger" definition.+-- +-- > decimalPlaces (fromInteger n) == 0 &&+-- > decimalMantissa (fromInteger n) == n+prop_fromIntegerZero :: Integer -> Bool+prop_fromIntegerZero n =  decimalPlaces (fromInteger n :: Decimal) == 0 &&+                          decimalMantissa (fromInteger n :: Decimal) == n+++-- | Increased precision does not affect equality.+-- +-- > decimalPlaces d < maxBound ==> roundTo (decimalPlaces d + 1) d == d+prop_increaseDecimals :: Decimal -> Property+prop_increaseDecimals d =  +    decimalPlaces d < maxBound ==> roundTo (decimalPlaces d + 1) d == d+++-- | Decreased precision can make two decimals equal, but it can never change+-- their order.+-- +-- > forAll d1, d2 :: Decimal -> legal beforeRound afterRound+-- >      where+-- >         beforeRound = compare d1 d2+-- >         afterRound = compare (roundTo 0 d1) (roundTo 0 d2)+-- >         legal GT x = x `elem` [GT, EQ]+-- >         legal EQ x = x `elem` [EQ]+-- >         legal LT x = x `elem` [LT, EQ]+prop_decreaseDecimals :: Decimal -> Decimal -> Bool+prop_decreaseDecimals d1 d2 =  legal beforeRound afterRound+    where+      beforeRound = compare d1 d2+      afterRound = compare (roundTo 0 d1) (roundTo 0 d2)+      legal GT x = x `elem` [GT, EQ]+      legal EQ x = x `elem` [EQ]+      legal LT x = x `elem` [LT, EQ]+++-- | > (x + y) - y == x+prop_inverseAdd :: Decimal -> Decimal -> Bool+prop_inverseAdd x y =  (x + y) - y == x+++-- | Multiplication is repeated addition.+-- +-- > forall d, NonNegative i : (sum $ replicate i d) == d * fromIntegral (max i 0)+prop_repeatedAdd :: Decimal -> Word8 -> Bool+prop_repeatedAdd d i = (sum $ replicate (fromIntegral i) d) == d * fromIntegral (max i 0)+++-- | Division produces the right number of parts.+-- +-- > forall d, Positive i : (sum $ map fst $ divide d i) == i+prop_divisionParts :: Decimal -> Positive Int -> Property+prop_divisionParts d (Positive i) =  i > 0 ==> (sum $ map fst $ divide d i) == i+++-- | Division doesn't drop any units.+-- +-- > forall d, Positive i : (sum $ map (\(n,d1) -> fromIntegral n * d1) $ divide d i) == d+prop_divisionUnits :: Decimal -> Positive Int -> Bool+prop_divisionUnits d (Positive i) = +    (sum $ map (\(n,d1) -> fromIntegral n * d1) $ divide d i) == d+++-- | Allocate produces the right number of parts.+-- +-- > sum ps /= 0  ==>  length ps == length (allocate d ps)+prop_allocateParts :: Decimal -> [Integer] -> Property+prop_allocateParts d ps =  +    sum ps /= 0 ==> length ps == length (allocate d ps)+++-- | Allocate doesn't drop any units.+-- +-- >     sum ps /= 0  ==>  sum (allocate d ps) == d+prop_allocateUnits :: Decimal -> [Integer] -> Property+prop_allocateUnits d ps =+    sum ps /= 0 ==> sum (allocate d ps) == d++-- | Absolute value definition+-- +-- > decimalPlaces a == decimalPlaces d && +-- > decimalMantissa a == abs (decimalMantissa d)+-- >    where a = abs d+prop_abs :: Decimal -> Bool+prop_abs d =  decimalPlaces a == decimalPlaces d && +              decimalMantissa a == abs (decimalMantissa d)+    where a = abs d++-- | Sign number defintion+-- +-- > signum d == (fromInteger $ signum $ decimalMantissa d)+prop_signum :: Decimal -> Bool+prop_signum d =  signum d == (fromInteger $ signum $ decimalMantissa d)++-- | The addition is valid+                 +prop_sumValid :: Decimal -> Decimal -> Property+prop_sumValid a b = (decimalPlaces a < maxBound && decimalPlaces b < maxBound) ==>+                    (toRational (a + b) == (toRational a) + (toRational b))++prop_mulValid :: Decimal -> Decimal -> Property+prop_mulValid a b = ((ad + bd) < fromIntegral (maxBound :: Word8)) ==>+                    (toRational (a * b) == (toRational a) * (toRational b))+  where+    ad :: Integer+    ad = fromIntegral $ decimalPlaces a+    bd = fromIntegral $ decimalPlaces b++prop_eitherFromRational :: Decimal -> Bool+prop_eitherFromRational d = (Right d) == (eitherFromRational $ toRational d)++prop_normalizeDecimal :: Decimal -> Bool+prop_normalizeDecimal d = d == (normalizeDecimal d)+++-- | Division is the inverted multiplication+prop_divisionMultiplication :: Decimal -> Decimal -> Property+prop_divisionMultiplication a b = ((ad + bd) < fromIntegral (maxBound :: Word8) && a /= 0 && b /= 0) ==>+                                  (c / a == b) .&&. (c / b == a)+  where+    ad :: Integer+    ad = fromIntegral $ decimalPlaces a+    bd = fromIntegral $ decimalPlaces b+    c = a * b++prop_fromRational :: Decimal -> Bool+prop_fromRational a = a == (fromRational $ toRational a)++prop_properFraction :: Decimal -> Bool+prop_properFraction a = a == (fromIntegral b + d)+  where+    b :: Integer+    (b, d) = properFraction a+ main :: IO () main = defaultMain tests @@ -43,7 +203,14 @@                 testProperty "allocateParts"      prop_allocateParts,                 testProperty "allocateUnits"      prop_allocateUnits,                 testProperty "abs"                prop_abs,-                testProperty "signum"             prop_signum+                testProperty "signum"             prop_signum,+                testProperty "sumvalid"           prop_sumValid,+                testProperty "mulValid"           prop_mulValid,+                testProperty "eitherFromRational" prop_eitherFromRational,+                testProperty "normalizeDecimal"   prop_normalizeDecimal,+                testProperty "divisionMultiplication" prop_divisionMultiplication,+                testProperty "fromRational"       prop_fromRational,+                testProperty "properFraction"     prop_properFraction                 ],         testGroup "Point tests Data.Decimal" [                 testCase "pi to 3dp"     (dec 3 3142  @=? realFracToDecimal 3 piD),