diff --git a/Decimal.cabal b/Decimal.cabal --- a/Decimal.cabal +++ b/Decimal.cabal @@ -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 diff --git a/README.txt b/README.txt --- a/README.txt +++ b/README.txt @@ -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). diff --git a/src/Data/Decimal.hs b/src/Data/Decimal.hs --- a/src/Data/Decimal.hs +++ b/src/Data/Decimal.hs @@ -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 diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -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),