From 3b703625251aaba276025a76227eddc04e86c231 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sat, 18 Oct 2014 12:09:43 -0700 Subject: [PATCH] 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 --- hledger-lib/Hledger/Data/Amount.hs | 45 ++++++++++++++++++++---------- hledger-lib/Hledger/Data/Types.hs | 18 +++++++++++- hledger-lib/hledger-lib.cabal | 10 +++++++ 3 files changed, 58 insertions(+), 15 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index f21368cae..445d2f5d4 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE StandaloneDeriving, RecordWildCards #-} +{-# LANGUAGE CPP, StandaloneDeriving, RecordWildCards #-} {-| A simple 'Amount' is some quantity of money, shares, or anything else. It has a (possibly null) 'Commodity' and a numeric quantity: @@ -99,6 +99,9 @@ module Hledger.Data.Amount ( ) where import Data.Char (isDigit) +#ifndef DOUBLE +import Data.Decimal +#endif import Data.Function (on) import Data.List import Data.Map (findWithDefault) @@ -147,11 +150,14 @@ missingamt :: Amount missingamt = amount{acommodity="AUTO"} -- handy amount constructors for tests +#ifdef DOUBLE +roundTo = flip const +#endif num n = amount{acommodity="", aquantity=n} -usd n = amount{acommodity="$", aquantity=n, astyle=amountstyle{asprecision=2}} -eur n = amount{acommodity="€", aquantity=n, astyle=amountstyle{asprecision=2}} -gbp n = amount{acommodity="£", aquantity=n, astyle=amountstyle{asprecision=2}} -hrs n = amount{acommodity="h", aquantity=n, astyle=amountstyle{asprecision=1, ascommodityside=R}} +usd n = amount{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} +eur n = amount{acommodity="€", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} +gbp n = amount{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} +hrs n = amount{acommodity="h", aquantity=roundTo 1 n, astyle=amountstyle{asprecision=1, ascommodityside=R}} amt `at` priceamt = amt{aprice=UnitPrice 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 -- precision set to the highest of either amount. -- 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. +similarAmountsOp :: (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount similarAmountsOp op Amount{acommodity=_, aquantity=q1, astyle=AmountStyle{asprecision=p1}} Amount{acommodity=c2, aquantity=q2, astyle=s2@AmountStyle{asprecision=p2}} = -- 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} -- | 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} -- | 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 ? -- Since we are using floating point, for now just test to some high precision. isReallyZeroAmount :: Amount -> Bool -isReallyZeroAmount a -- a==missingamt = False - | otherwise = (null . filter (`elem` digits) . printf ("%."++show zeroprecision++"f") . aquantity) a - where zeroprecision = 8 +isReallyZeroAmount Amount{aquantity=q} = iszero q + where + 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 -- display settings except using the specified precision. @@ -279,9 +290,15 @@ showamountquantity Amount{aquantity=q, astyle=AmountStyle{asprecision=p, asdecim where -- isint n = fromIntegral (round n) == n qstr -- p == maxprecision && isint q = printf "%d" (round q::Integer) - | p == maxprecisionwithpoint = printf "%f" q - | p == maxprecision = chopdotzero $ printf "%f" q - | otherwise = printf ("%."++show p++"f") q +#ifdef DOUBLE + | p == maxprecisionwithpoint = printf "%f" q + | p == maxprecision = chopdotzero $ printf "%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, -- 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 -- | 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 -- | Is this mixed amount negative, if it can be normalised to a single commodity ? diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index c9e8422ab..62d1c6d4b 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} +{-# LANGUAGE CPP, DeriveDataTypeable, StandaloneDeriving, TypeSynonymInstances, FlexibleInstances #-} {-| Most data types are defined here to avoid import cycles. @@ -21,6 +21,10 @@ module Hledger.Data.Types where import Control.Monad.Error (ErrorT) import Data.Data +#ifndef DOUBLE +import Data.Decimal +import Text.Blaze (ToMarkup(..)) +#endif import qualified Data.Map as M import Data.Time.Calendar import Data.Time.LocalTime @@ -46,7 +50,19 @@ data Side = L | R deriving (Eq,Show,Read,Ord,Typeable,Data) 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 +#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. -- Note the price should be a positive number, although this is not enforced. diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index ff22918cc..3cd8aad30 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -30,11 +30,17 @@ extra-source-files: -- sample.ledger -- sample.timelog +flag double + Description: Use old Double number representation (instead of Decimal), for testing/benchmarking. + Default: False + library -- should set patchlevel here as in Makefile cpp-options: -DPATCHLEVEL=0 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 + if flag(double) + cpp-options: -DDOUBLE default-language: Haskell2010 exposed-modules: Hledger @@ -70,11 +76,13 @@ library Hledger.Utils.UTF8IOCompat build-depends: base >= 4.3 && < 5 + ,blaze-markup >= 0.5.1 ,bytestring ,cmdargs >= 0.10 && < 0.11 ,containers ,csv -- ,data-pprint >= 0.2.3 && < 0.3 + ,Decimal ,directory ,filepath ,mtl @@ -104,10 +112,12 @@ test-suite tests default-language: Haskell2010 build-depends: hledger-lib , base >= 4.3 && < 5 + , blaze-markup >= 0.5.1 , cmdargs , containers , csv -- , data-pprint >= 0.2.3 && < 0.3 + , Decimal , directory , filepath , HUnit