module Data.Decimal (
DecimalRaw (..),
Decimal,
realFracToDecimal,
decimalConvert,
roundTo,
(*.),
divide,
allocate,
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 Data.Char
import Data.Ratio
import Data.Word
import Test.QuickCheck
import Text.ParserCombinators.ReadP
data (Integral i) => DecimalRaw i = Decimal {
decimalPlaces :: ! Word8,
decimalMantissa :: ! i}
type Decimal = DecimalRaw Integer
realFracToDecimal :: (Integral i, RealFrac r) => Word8 -> r -> DecimalRaw i
realFracToDecimal e r = Decimal e $ round (r * (10^e))
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
decimalConvert :: (Integral a, Integral b) => DecimalRaw a -> DecimalRaw b
decimalConvert (Decimal e n) = Decimal e $ fromIntegral n
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 ^ (ed)
multiplier = 10 ^ (de)
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
instance (Integral i, Arbitrary i) => CoArbitrary (DecimalRaw i) where
coarbitrary (Decimal e m) gen = variant (v:: Integer) gen
where v = fromIntegral e + fromIntegral m
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 :: (Integral i) => DecimalRaw i -> [Integer] -> [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
(*.) :: (Integral i, RealFrac r) => DecimalRaw i -> r -> DecimalRaw i
(Decimal e m) *. d = Decimal e $ round $ fromIntegral m * d
prop_readShow :: Decimal -> Bool
prop_readShow d = read (show d) == d
prop_readShowPrecision :: Decimal -> Bool
prop_readShowPrecision d = decimalPlaces (read (show d) :: Decimal)
== decimalPlaces d
prop_fromIntegerZero :: Integer -> Bool
prop_fromIntegerZero n = decimalPlaces (fromInteger n :: Decimal) == 0 &&
decimalMantissa (fromInteger n :: Decimal) == n
prop_increaseDecimals :: Decimal -> Property
prop_increaseDecimals d =
decimalPlaces d < maxBound ==> roundTo (decimalPlaces d + 1) d == d
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]
prop_inverseAdd :: Decimal -> Decimal -> Bool
prop_inverseAdd x y = (x + y) y == x
prop_repeatedAdd :: Decimal -> Word8 -> Bool
prop_repeatedAdd d i = (sum $ replicate (fromIntegral i) d) == d * fromIntegral (max i 0)
prop_divisionParts :: Decimal -> Positive Int -> Property
prop_divisionParts d (Positive i) = i > 0 ==> (sum $ map fst $ divide d i) == i
prop_divisionUnits :: Decimal -> Positive Int -> Bool
prop_divisionUnits d (Positive i) =
(sum $ map (\(n,d1) -> fromIntegral n * d1) $ divide d i) == d
prop_allocateParts :: Decimal -> [Integer] -> Property
prop_allocateParts d ps =
sum ps /= 0 ==> length ps == length (allocate d ps)
prop_allocateUnits :: Decimal -> [Integer] -> Property
prop_allocateUnits d ps =
sum ps /= 0 ==> sum (allocate d ps) == d
prop_abs :: Decimal -> Bool
prop_abs d = decimalPlaces a == decimalPlaces d &&
decimalMantissa a == abs (decimalMantissa d)
where a = abs d
prop_signum :: Decimal -> Bool
prop_signum d = signum d == (fromInteger $ signum $ decimalMantissa d)