optimise canonicaliseAmounts

First optimisation in a while. hledger -s bal on my ledger took 2s, and profiling showed:

	total time  =        0.66 secs   (33 ticks @ 20 ms)
	total alloc = 3,631,667,848 bytes  (excludes profiling overheads)

     canonicaliseAmounts                             1   0.0    0.8      69.7       92.4
      rawLedgerCommoditiesWithSymbol              3928  27.3   23.1      69.7       91.6
       rawLedgerCommodities                          0  18.2   18.7      42.4       68.5
        amounts                                7712628   3.0    0.0       3.0        0.0
        rawLedgerAmounts                             0   0.0    9.3      21.2       49.9
         rawLedgerTransactions                       0   9.1   19.5      21.2       40.5
          flattenEntry                         3408636  12.1   21.0      12.1       21.0

Now it takes 1/2s and the profile is healthier:

	total time  =        0.14 secs   (7 ticks @ 20 ms)
	total alloc = 275,520,536 bytes  (excludes profiling overheads)

     canonicaliseAmounts                             1   0.0    0.4       0.0        0.5
      amounts                                     1964   0.0    0.0       0.0        0.0
      rawLedgerTransactions                          0   0.0    0.1       0.0        0.1
       flattenEntry                                868   0.0    0.1       0.0        0.1
This commit is contained in:
Simon Michael 2008-12-05 02:09:19 +00:00
parent 0be862f760
commit b51740e9bb

View File

@ -8,6 +8,7 @@ the cached 'Ledger'.
module Ledger.RawLedger
where
import qualified Data.Map as Map
import Data.Map ((!))
import Ledger.Utils
import Ledger.Types
import Ledger.AccountName
@ -92,36 +93,32 @@ filterRawLedgerEntriesByAccount apats (RawLedger ms ps es f) =
-- detected. Also, amounts are converted to cost basis if that flag is
-- active.
canonicaliseAmounts :: Bool -> RawLedger -> RawLedger
canonicaliseAmounts costbasis l@(RawLedger ms ps es f) = RawLedger ms ps (map fixEntryAmounts es) f
canonicaliseAmounts costbasis l@(RawLedger ms ps es f) = RawLedger ms ps (map fixentry es) f
where
fixEntryAmounts (Entry d s c de co ts pr) = Entry d s c de co (map fixRawTransactionAmounts ts) pr
fixRawTransactionAmounts (RawTransaction ac a c t) = RawTransaction ac (fixMixedAmount a) c t
fixMixedAmount (Mixed as) = Mixed $ map fixAmount as
fixAmount | costbasis = fixcommodity . costOfAmount
| otherwise = fixcommodity
fixcommodity a = a{commodity=canonicalcommodity $ commodity a}
canonicalcommodity c = (firstoccurrenceof c){precision=maxprecision c}
where
firstoccurrenceof c = head $ rawLedgerCommoditiesWithSymbol l (symbol c)
maxprecision c = maximum $ map precision $ rawLedgerCommoditiesWithSymbol l (symbol c)
-- | Get all amount commodities with a given symbol, in the order parsed.
-- Must be called with a good symbol or it will fail.
rawLedgerCommoditiesWithSymbol :: RawLedger -> String -> [Commodity]
rawLedgerCommoditiesWithSymbol l s =
fromMaybe (error $ "no such commodity "++s) (Map.lookup s map)
where
map = Map.fromList [(symbol $ head cs,cs) | cs <- groupBy same $ rawLedgerCommodities l]
same c1 c2 = symbol c1 == symbol c2
-- | Get just the ammount commodities from a ledger, in the order parsed.
rawLedgerCommodities :: RawLedger -> [Commodity]
rawLedgerCommodities = map commodity . concatMap amounts . rawLedgerAmounts
fixentry (Entry d s c de co ts pr) = Entry d s c de co (map fixrawtransaction ts) pr
fixrawtransaction (RawTransaction ac a c t) = RawTransaction ac (fixmixedamount a) c t
fixmixedamount (Mixed as) = Mixed $ map fixamount as
fixamount = fixcommodity . (if costbasis then costOfAmount else id)
fixcommodity a = a{commodity=c} where c = canonicalcommoditymap ! (symbol $ commodity a)
canonicalcommoditymap =
Map.fromList [(s,firstc{precision=maxp}) | s <- commoditysymbols,
let cs = commoditymap ! s,
let firstc = head cs,
let maxp = maximum $ map precision cs
]
commoditymap = Map.fromList [(s,commoditieswithsymbol s) | s <- commoditysymbols]
commoditieswithsymbol s = filter ((s==) . symbol) commodities
commoditysymbols = nub $ map symbol commodities
commodities = map commodity $ concatMap (amounts . amount) $ rawLedgerTransactions l
-- | Get just the amounts from a ledger, in the order parsed.
rawLedgerAmounts :: RawLedger -> [MixedAmount]
rawLedgerAmounts = map amount . rawLedgerTransactions
-- | Get just the ammount commodities from a ledger, in the order parsed.
rawLedgerCommodities :: RawLedger -> [Commodity]
rawLedgerCommodities = map commodity . concatMap amounts . rawLedgerAmounts
-- | Get just the amount precisions from a ledger, in the order parsed.
rawLedgerPrecisions :: RawLedger -> [Int]
rawLedgerPrecisions = map precision . rawLedgerCommodities