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:
parent
5f32855040
commit
3b70362525
@ -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 ?
|
||||||
|
|||||||
@ -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.
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user