Decimal (empty) → 0.1.0

raw patch · 8 files changed

+514/−0 lines, 8 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base

Files

• Decimal.cabal +19/−0
• INSTALL.txt +14/−0
• LICENSE.txt +30/−0
• README.txt +30/−0
• Setup.hs +5/−0
• src/Data/Decimal.hs +334/−0
• tests/Main.hs +66/−0
• tests/Makefile +16/−0

@@ -0,0 +1,19 @@+Name:               Decimal+Version:            0.1.0+License:            BSD3+License-file:       LICENSE.txt+Copyright:          Paul Johnson, 2008+Author:             Paul Johnson+Maintainer:         paul@cogito.org.uk+Stability:          beta+Category:           Math+Build-Depends:	    base, QuickCheck, HUnit+Build-type:         Simple+Synopsis:           Decimal numbers with variable precision+Description:        A decimal number has an integer mantissa and a negative+                    exponent.  The exponent can be interpreted as the number+                    of decimal places in the value.+Exposed-modules:    Data.Decimal+Extra-source-files: tests/Makefile, tests/Main.hs, README.txt, INSTALL.txt+ghc-options:        -Wall+hs-source-dirs:     src

@@ -0,0 +1,14 @@+As user, from within the project directory:++   runghc Setup.hs configure+   runghc Setup.hs build++As root or administrator:++   runghc Setup.hs install++If you have Haddock then generate the documentation with:++   runghc Setup.hs haddock++If you use Hugs then type "runhugs" instead of "runghc".

@@ -0,0 +1,30 @@+Copyright (c) 2008, Paul Johnson+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above copyright+      notice, this list of conditions and the following disclaimer in+      the documentation and/or other materials provided with the+      distribution.++    * Neither the name of the Decimal project nor the names of its+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY+OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,30 @@+Variable Precision Decimal Numbers+==================================++The "Decimal" type is mainly intended for doing financial arithmetic+where the number of decimal places may not be known at compile time+(e.g. for a program that handles both Yen and Dollars) and the+application must not drop pennies on the floor.  For instance if you+have to divide $10 between three people then one of them has to get+$3.34.++The number of decimal places in a value is represented as a Word8,+allowing for up to 255 decimal places.  Functions preserve precision.+Binary operators return a result with the precision of the most+precise argument, so 2.3 + 5.678 = 7.978.++If you need fixed precision decimal arithmetic where the precision is+known at compile time then Data.Number.Fixed from Lennart Augustsson's+"numbers" package is more likely to be what you want.++QuickCheck Specification+------------------------++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 go into the "tests" directory and+type "make all".  A test coverage report will automatically be+produced in "tests/Report".++Data.Decimal is an instance of Arbitrary, for your convenience in+writing your own tests.

@@ -0,0 +1,5 @@+module Main where++import Distribution.Simple++main = defaultMain

@@ -0,0 +1,334 @@+-- | 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@.+-- +-- Unary arithmetic results have the exponent of the argument.  Binary+-- arithmetic results have an exponent equal to the maximum of the exponents+-- of the arguments.+-- +-- Decimal numbers are defined as instances of @Real@.  This means that+-- conventional division is not defined.  Instead the functions @divide@ and +-- @allocate@ will split a decimal amount into lists of results.  These +-- results are guaranteed to sum to the original number.  This is a useful+-- property when doing financial arithmetic.+-- +-- The arithmetic on mantissas is always done using @Integer@, regardless of+-- the type of @DecimalRaw@ being manipulated.  In practice it is recommended+-- that @Decimal@ be used, with other types being used only where necessary+-- (e.g. to conform to a network protocol).++module Data.Decimal (+   -- ** Decimal Values+   DecimalRaw (..),+   Decimal,+   realFracToDecimal,+   decimalConvert,+   roundTo,+   (*.),+   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+) where+++import Control.Monad+import Data.Char+import Data.Ratio+import Data.Word+import Test.QuickCheck+import Text.ParserCombinators.ReadP++-- | Raw decimal arithmetic type constructor.  A decimal value consists of an+-- integer mantissa and a negative exponent which is interpreted as the number+-- of decimal places.  The value stored in a @Decimal d@ is therefore equal to:+-- +-- > decimalMantissa d / (10 ^ decimalPlaces d)+-- +-- The "Show" instance will add trailing zeros, so @show $ Decimal 3 1500@+-- will return \"1.500\".  Conversely the "Read" instance will use the decimal+-- places to determine the precision.+-- +-- Arithmetic and comparision operators convert their arguments to the +-- greater of the two precisions, and return a result of that precision.  +-- Regardless of the type of the arguments, all mantissa arithmetic is done+-- using @Integer@ types, so application developers do not need to worry about+-- overflow in the internal algorithms.  However the result of each operator+-- will be converted to the mantissa type without checking for overflow.+data (Integral i) => DecimalRaw i = Decimal {+      decimalPlaces :: Word8,+      decimalMantissa :: i}+++-- | Arbitrary precision decimal type.  As a rule programs should do decimal+-- arithmetic with this type and only convert to other instances of +-- "DecimalRaw" where required by an external interface.+-- +-- Using this type is also faster because it avoids repeated conversions+-- to and from @Integer@.+type Decimal = DecimalRaw Integer+++-- | Convert a real fractional value into a Decimal of the appropriate +-- precision.+realFracToDecimal :: (Integral i, RealFrac r) => Word8 -> r -> DecimalRaw i+realFracToDecimal e r = Decimal e $ round (r * (10^e))+++-- Internal function to divide and return the nearest integer.+divRound :: (Integral a) => a -> a -> a+divRound n1 n2 = if abs r > abs (n2 `quot` 2) then n + signum n else n+    where (n, r) = n1 `quotRem` n2+++-- | Convert a @DecimalRaw@ from one base representation to another.  Does+-- not check for overflow in the new representation.+decimalConvert :: (Integral a, Integral b) => DecimalRaw a -> DecimalRaw b+decimalConvert (Decimal e n) = Decimal e $ fromIntegral n+++-- | Round a @DecimalRaw@ to a specified number of decimal places.+roundTo :: (Integral i) => Word8 -> DecimalRaw i -> DecimalRaw Integer+roundTo d (Decimal e n) = Decimal d $ fromIntegral n1+    where+      n1 = case compare d e of+             LT -> n `divRound` divisor+             EQ -> n+             GT -> n * multiplier+      divisor = 10 ^ (e-d)+      multiplier = 10 ^ (d-e)+++-- Round the two DecimalRaw values to the largest exponent.+roundMax :: (Integral i) => +            DecimalRaw i -> DecimalRaw i -> (Word8, Integer, Integer)+roundMax d1@(Decimal e1 _) d2@(Decimal e2 _) = (e, n1, n2)+    where+      e = max e1 e2+      (Decimal _ n1) = roundTo e d1+      (Decimal _ n2) = roundTo e d2+++instance (Integral i) => Show (DecimalRaw i) where+   showsPrec _ (Decimal e n)+       | e == 0     = (concat [signStr, strN] ++)+       | otherwise  = (concat [signStr, intPart, ".", fracPart] ++)+       where+         strN = show $ abs n+         signStr = if n < 0 then "-" else ""+         len = length strN+         padded = replicate (fromIntegral e + 1 - len) '0' ++ strN+         (intPart, fracPart) = splitAt (max 1 (len - fromIntegral e)) padded++instance (Integral i, Read i) => Read (DecimalRaw i) where+    readsPrec _ = +        readP_to_S $ do+          (intPart, _) <- gather $ do+                            optional $ char '-'+                            munch1 isDigit+          fractPart    <- option "" $ do+                            char '.'+                            munch1 isDigit+          return $ Decimal (fromIntegral $ length fractPart) $ read $ +                 intPart ++ fractPart+++instance (Integral i) => Eq (DecimalRaw i) where+   d1 == d2   =   n1 == n2 where (_, n1, n2) = roundMax d1 d2+++instance (Integral i) => Ord (DecimalRaw i) where+    compare d1 d2 = compare n1 n2 where (_, n1, n2) = roundMax d1 d2+++instance (Integral i) => Num (DecimalRaw i) where+    d1 + d2 = Decimal e $ fromIntegral (n1 + n2)+        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+    abs (Decimal e n) = Decimal e $ abs n+    signum (Decimal _ n) = fromIntegral $ signum n+    fromInteger n = Decimal 0 $ fromIntegral n++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+    coarbitrary (Decimal e m) gen = +        variant (fromIntegral e + fromIntegral m) gen+++-- | Divide a @DecimalRaw@ value into one or more portions.  The portions+-- will be approximately equal, and the sum of the portions is guaranteed to+-- be the original value.+-- +-- The portions are represented as a list of pairs.  The first part of each+-- pair is the number of portions, and the second part is the portion value.+-- Hence 10 dollars divided 3 ways will produce @[(2, 3.33), (1, 3.34)]@.+divide :: (Integral i) => DecimalRaw i -> Int -> [(Int, DecimalRaw i)]+divide (Decimal e n) d +    | d > 0 = +        case n `divMod` fromIntegral d of+          (result, 0) -> [(fromIntegral d, Decimal e result)]+          (result, r) -> [(fromIntegral d - fromIntegral r,+                           Decimal e result), +                          (fromIntegral r, Decimal e (result+1))]+    | otherwise = error "Data.Decimal.divide: Divisor must be > 0."++++-- | Allocate a @DecimalRaw@ value proportionately with the values in a list.+-- The allocated portions are guaranteed to add up to the original value.+-- +-- Some of the allocations may be zero or negative, but the sum of the list +-- must not be zero.  The allocation is intended to be as close as possible+-- to the following:+-- +-- > let result = allocate d parts+-- > in all (== d / sum parts) $ zipWith (/) result parts+allocate :: (Integral i) => DecimalRaw i -> [Int] -> [DecimalRaw i]+allocate (Decimal e n) ps+    | total == 0  = +        error "Data.Decimal.allocate: allocation list must not sum to zero."+    | otherwise   = map (Decimal e) $ zipWith (-) ts (tail ts)+    where+      ts = map fst $ scanl nxt (n, total) ps+      nxt (n1, t1) p1 = (n1 - (n1 * fromIntegral p1) `zdiv` t1, +                         t1 - fromIntegral p1)+      zdiv 0 0 = 0+      zdiv x y = x `divRound` y+      total = fromIntegral $ sum ps+++-- | Multiply a @DecimalRaw@ by a @RealFrac@ value.+(*.) :: (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.+-- +-- > (sum $ replicate i d) == d * fromIntegral (max i 0)+prop_repeatedAdd :: Decimal -> Int -> Bool+prop_repeatedAdd d i = (sum $ replicate i d) == d * fromIntegral (max i 0)+++-- | Division produces the right number of parts.+-- +-- > i > 0 ==> (sum $ map fst $ divide d i) == i+prop_divisionParts :: Decimal -> Int -> Property+prop_divisionParts d i =  i > 0 ==> (sum $ map fst $ divide d i) == i+++-- | Division doesn't drop any units.+-- +-- > i > 0 ==> (sum $ map (\(n,d1) -> fromIntegral n * d1) $ divide d i) == d+prop_divisionUnits :: Decimal -> Int -> Property+prop_divisionUnits d i = +    i > 0 ==> (sum $ map (\(n,d1) -> fromIntegral n * d1) $ divide d i) == d+++-- | Allocate produces the right number of parts.+-- +-- > (not . null) ps ==> length ps == length (allocate d ps)+prop_allocateParts :: Decimal -> [Int] -> Property+prop_allocateParts d ps =  +    sum ps /= 0 ==> length ps == length (allocate d ps)+++-- | Allocate doesn't drop any units.+-- +-- >     (not . null) ps ==> sum (allocate d ps) == d+prop_allocateUnits :: Decimal -> [Int] -> 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)

@@ -0,0 +1,66 @@+module Main where++import Data.Decimal+import Data.Ratio+import Test.HUnit+import Test.QuickCheck+++conf :: Config+conf = defaultConfig { configMaxTest = 1000, configMaxFail = 10000 }+++main :: IO ()+main = do+  putStrLn "QuickCheck Data.Decimal:"+  putStr "     * prop_readShow           "+  check conf $ prop_readShow+  putStr "     * prop_readShowPrecision  "+  check conf $ prop_readShowPrecision+  putStr "     * prop_fromIntegerZero    "+  check conf $ prop_fromIntegerZero+  putStr "     * prop_increaseDecimals   "+  check conf $ prop_increaseDecimals+  putStr "     * prop_decreaseDecimals   "+  check conf $ prop_decreaseDecimals+  putStr "     * prop_inverseAdd         "+  check conf $ prop_inverseAdd+  putStr "     * prop_repeatedAdd        "+  check conf $ prop_repeatedAdd+  putStr "     * prop_divisionParts      "+  check conf $ prop_divisionParts+  putStr "     * prop_divisionUnits      "+  check conf $ prop_divisionUnits+  putStr "     * prop_allocateParts      "+  check conf $ prop_allocateParts+  putStr "     * prop_allocateUnits      "+  check conf $ prop_allocateUnits+  putStr "     * prop_abs                "+  check conf $ prop_abs+  putStr "     * prop_signum             "+  check conf $ prop_signum++  putStrLn "Point tests:"+  runTestTT $ TestList+       [ TestCase $ assertEqual "pi to 3dp" +                      (Decimal 3 3142 :: Decimal)+                      (realFracToDecimal 3 (pi :: Double)),+         TestCase $ assertEqual "pi to 2dp"+                      (Decimal 2 314 :: Decimal)+                      (realFracToDecimal 2 (pi :: Double)),+         TestCase $ assertEqual "100*pi to 2dp"+                      (Decimal 2 31416 :: Decimal)+                      (realFracToDecimal 2 (100 * pi :: Double)),+         TestCase $ assertEqual "1.0 * pi"+                      (Decimal 1 31 :: Decimal)+                      (Decimal 1 10 *. (pi :: Double)),+         TestCase $ assertEqual "1.23 * pi"+                      (Decimal 2 386 :: Decimal)+                      (Decimal 2 123 *. (pi :: Double)),+         TestCase $ assertEqual "Decimal to DecimalRaw Int"+                      (Decimal 2 123 :: DecimalRaw Int)+                      (decimalConvert (Decimal 2 123 :: Decimal)),+         TestCase $ assertEqual "1.234 to rational"+                      (toRational (Decimal 3 1234 :: Decimal)) (1234 % 1000)+       ]+  putStrLn "Tests completed."

@@ -0,0 +1,16 @@+# Tests for Decimal numbers.++all:+	ghc --make -fhpc -i../src -odir . -hidir . -Wall Main.hs -o test-rset+	rm -f test-rset.tix+	./test-rset+	hpc markup --destdir=Report test-rset+	hpc report test-rset++clean:+	rm -fR Data+	rm -f test-rset.tix+	rm -f test-rset+	rm -f *.o *.hi+	rm -fR Report+