switch to Decimal for representing quantities (closes #118)

hledger has represented quantities with floating point (Double) until
now.  While this has been working fine in practice, the time has come to
upgrade our number representation to something more principled: Decimal,
for now. As a bonus, this brings a ~30% speed boost to most reports.

We'll keep the old representation(s) around for a while, selectable via
hledger-lib cabal flag, for research/testing/benchmarking purposes. To
build with the old Double representation: cabal install -fdouble
hledger-lib hledger hledger-web
This commit is contained in:
Simon Michael 2014-10-18 12:09:43 -07:00
parent 5f32855040
commit 3b70362525
3 changed files with 58 additions and 15 deletions

View File

@ -1,4 +1,4 @@
{-# LANGUAGE StandaloneDeriving, RecordWildCards #-} {-# LANGUAGE CPP, StandaloneDeriving, RecordWildCards #-}
{-| {-|
A simple 'Amount' is some quantity of money, shares, or anything else. A simple 'Amount' is some quantity of money, shares, or anything else.
It has a (possibly null) 'Commodity' and a numeric quantity: It has a (possibly null) 'Commodity' and a numeric quantity:
@ -99,6 +99,9 @@ module Hledger.Data.Amount (
) where ) where
import Data.Char (isDigit) import Data.Char (isDigit)
#ifndef DOUBLE
import Data.Decimal
#endif
import Data.Function (on) import Data.Function (on)
import Data.List import Data.List
import Data.Map (findWithDefault) import Data.Map (findWithDefault)
@ -147,11 +150,14 @@ missingamt :: Amount
missingamt = amount{acommodity="AUTO"} missingamt = amount{acommodity="AUTO"}
-- handy amount constructors for tests -- handy amount constructors for tests
#ifdef DOUBLE
roundTo = flip const
#endif
num n = amount{acommodity="", aquantity=n} num n = amount{acommodity="", aquantity=n}
usd n = amount{acommodity="$", aquantity=n, astyle=amountstyle{asprecision=2}} usd n = amount{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}}
eur n = amount{acommodity="", aquantity=n, astyle=amountstyle{asprecision=2}} eur n = amount{acommodity="", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}}
gbp n = amount{acommodity="£", aquantity=n, astyle=amountstyle{asprecision=2}} gbp n = amount{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}}
hrs n = amount{acommodity="h", aquantity=n, astyle=amountstyle{asprecision=1, ascommodityside=R}} hrs n = amount{acommodity="h", aquantity=roundTo 1 n, astyle=amountstyle{asprecision=1, ascommodityside=R}}
amt `at` priceamt = amt{aprice=UnitPrice priceamt} amt `at` priceamt = amt{aprice=UnitPrice priceamt}
amt @@ priceamt = amt{aprice=TotalPrice priceamt} amt @@ priceamt = amt{aprice=TotalPrice priceamt}
@ -161,8 +167,8 @@ amt @@ priceamt = amt{aprice=TotalPrice priceamt}
-- The result's display style is that of the second amount, with -- The result's display style is that of the second amount, with
-- precision set to the highest of either amount. -- precision set to the highest of either amount.
-- Prices are ignored and discarded. -- Prices are ignored and discarded.
similarAmountsOp :: (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount
-- Remember: the caller is responsible for ensuring both amounts have the same commodity. -- Remember: the caller is responsible for ensuring both amounts have the same commodity.
similarAmountsOp :: (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount
similarAmountsOp op Amount{acommodity=_, aquantity=q1, astyle=AmountStyle{asprecision=p1}} similarAmountsOp op Amount{acommodity=_, aquantity=q1, astyle=AmountStyle{asprecision=p1}}
Amount{acommodity=c2, aquantity=q2, astyle=s2@AmountStyle{asprecision=p2}} = Amount{acommodity=c2, aquantity=q2, astyle=s2@AmountStyle{asprecision=p2}} =
-- trace ("a1:"++showAmountDebug a1) $ trace ("a2:"++showAmountDebug a2) $ traceWith (("= :"++).showAmountDebug) -- trace ("a1:"++showAmountDebug a1) $ trace ("a2:"++showAmountDebug a2) $ traceWith (("= :"++).showAmountDebug)
@ -188,7 +194,7 @@ costOfAmount a@Amount{aquantity=q, aprice=price} =
TotalPrice p@Amount{aquantity=pq} -> p{aquantity=pq * signum q} TotalPrice p@Amount{aquantity=pq} -> p{aquantity=pq * signum q}
-- | Divide an amount's quantity by a constant. -- | Divide an amount's quantity by a constant.
divideAmount :: Amount -> Double -> Amount divideAmount :: Amount -> Quantity -> Amount
divideAmount a@Amount{aquantity=q} d = a{aquantity=q/d} divideAmount a@Amount{aquantity=q} d = a{aquantity=q/d}
-- | Is this amount negative ? The price is ignored. -- | Is this amount negative ? The price is ignored.
@ -205,9 +211,14 @@ isZeroAmount a -- a==missingamt = False
-- | Is this amount "really" zero, regardless of the display precision ? -- | Is this amount "really" zero, regardless of the display precision ?
-- Since we are using floating point, for now just test to some high precision. -- Since we are using floating point, for now just test to some high precision.
isReallyZeroAmount :: Amount -> Bool isReallyZeroAmount :: Amount -> Bool
isReallyZeroAmount a -- a==missingamt = False isReallyZeroAmount Amount{aquantity=q} = iszero q
| otherwise = (null . filter (`elem` digits) . printf ("%."++show zeroprecision++"f") . aquantity) a where
where zeroprecision = 8 iszero =
#ifdef DOUBLE
null . filter (`elem` digits) . printf ("%."++show zeroprecision++"f") where zeroprecision = 8
#else
(==0)
#endif
-- | Get the string representation of an amount, based on its commodity's -- | Get the string representation of an amount, based on its commodity's
-- display settings except using the specified precision. -- display settings except using the specified precision.
@ -279,9 +290,15 @@ showamountquantity Amount{aquantity=q, astyle=AmountStyle{asprecision=p, asdecim
where where
-- isint n = fromIntegral (round n) == n -- isint n = fromIntegral (round n) == n
qstr -- p == maxprecision && isint q = printf "%d" (round q::Integer) qstr -- p == maxprecision && isint q = printf "%d" (round q::Integer)
#ifdef DOUBLE
| p == maxprecisionwithpoint = printf "%f" q | p == maxprecisionwithpoint = printf "%f" q
| p == maxprecision = chopdotzero $ printf "%f" q | p == maxprecision = chopdotzero $ printf "%f" q
| otherwise = printf ("%."++show p++"f") q | otherwise = printf ("%."++show p++"f") q
#else
| p == maxprecisionwithpoint = show q
| p == maxprecision = chopdotzero $ show q
| otherwise = show $ roundTo (fromIntegral p) q
#endif
-- | Replace a number string's decimal point with the specified character, -- | Replace a number string's decimal point with the specified character,
-- and add the specified digit group separators. The last digit group will -- and add the specified digit group separators. The last digit group will
@ -460,7 +477,7 @@ costOfMixedAmount :: MixedAmount -> MixedAmount
costOfMixedAmount (Mixed as) = Mixed $ map costOfAmount as costOfMixedAmount (Mixed as) = Mixed $ map costOfAmount as
-- | Divide a mixed amount's quantities by a constant. -- | Divide a mixed amount's quantities by a constant.
divideMixedAmount :: MixedAmount -> Double -> MixedAmount divideMixedAmount :: MixedAmount -> Quantity -> MixedAmount
divideMixedAmount (Mixed as) d = Mixed $ map (flip divideAmount d) as divideMixedAmount (Mixed as) d = Mixed $ map (flip divideAmount d) as
-- | Is this mixed amount negative, if it can be normalised to a single commodity ? -- | Is this mixed amount negative, if it can be normalised to a single commodity ?

View File

@ -1,4 +1,4 @@
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} {-# LANGUAGE CPP, DeriveDataTypeable, StandaloneDeriving, TypeSynonymInstances, FlexibleInstances #-}
{-| {-|
Most data types are defined here to avoid import cycles. Most data types are defined here to avoid import cycles.
@ -21,6 +21,10 @@ module Hledger.Data.Types
where where
import Control.Monad.Error (ErrorT) import Control.Monad.Error (ErrorT)
import Data.Data import Data.Data
#ifndef DOUBLE
import Data.Decimal
import Text.Blaze (ToMarkup(..))
#endif
import qualified Data.Map as M import qualified Data.Map as M
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.LocalTime import Data.Time.LocalTime
@ -46,7 +50,19 @@ data Side = L | R deriving (Eq,Show,Read,Ord,Typeable,Data)
type Commodity = String type Commodity = String
-- | The basic numeric type used in amounts. Different implementations
-- can be selected via cabal flag for testing and benchmarking purposes.
#ifdef DOUBLE
type Quantity = Double type Quantity = Double
#else
type Quantity = Decimal
deriving instance Data (Quantity)
-- The following is for hledger-web, and requires blaze-markup.
-- Doing it here avoids needing a matching flag on the hledger-web package.
instance ToMarkup (Quantity)
where
toMarkup = toMarkup . show
#endif
-- | An amount's price (none, per unit, or total) in another commodity. -- | An amount's price (none, per unit, or total) in another commodity.
-- Note the price should be a positive number, although this is not enforced. -- Note the price should be a positive number, although this is not enforced.

View File

@ -30,11 +30,17 @@ extra-source-files:
-- sample.ledger -- sample.ledger
-- sample.timelog -- sample.timelog
flag double
Description: Use old Double number representation (instead of Decimal), for testing/benchmarking.
Default: False
library library
-- should set patchlevel here as in Makefile -- should set patchlevel here as in Makefile
cpp-options: -DPATCHLEVEL=0 cpp-options: -DPATCHLEVEL=0
ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures
ghc-options: -fno-warn-type-defaults -fno-warn-orphans ghc-options: -fno-warn-type-defaults -fno-warn-orphans
if flag(double)
cpp-options: -DDOUBLE
default-language: Haskell2010 default-language: Haskell2010
exposed-modules: exposed-modules:
Hledger Hledger
@ -70,11 +76,13 @@ library
Hledger.Utils.UTF8IOCompat Hledger.Utils.UTF8IOCompat
build-depends: build-depends:
base >= 4.3 && < 5 base >= 4.3 && < 5
,blaze-markup >= 0.5.1
,bytestring ,bytestring
,cmdargs >= 0.10 && < 0.11 ,cmdargs >= 0.10 && < 0.11
,containers ,containers
,csv ,csv
-- ,data-pprint >= 0.2.3 && < 0.3 -- ,data-pprint >= 0.2.3 && < 0.3
,Decimal
,directory ,directory
,filepath ,filepath
,mtl ,mtl
@ -104,10 +112,12 @@ test-suite tests
default-language: Haskell2010 default-language: Haskell2010
build-depends: hledger-lib build-depends: hledger-lib
, base >= 4.3 && < 5 , base >= 4.3 && < 5
, blaze-markup >= 0.5.1
, cmdargs , cmdargs
, containers , containers
, csv , csv
-- , data-pprint >= 0.2.3 && < 0.3 -- , data-pprint >= 0.2.3 && < 0.3
, Decimal
, directory , directory
, filepath , filepath
, HUnit , HUnit