optimise summariseTransactionsInDateSpan like cacheLedger

makes summarised register reports faster
This commit is contained in:
Simon Michael 2008-12-05 03:32:41 +00:00
parent 63999d36fe
commit b1f2d95e13

View File

@ -76,28 +76,36 @@ summariseTransactionsInDateSpan (DateSpan b e) entryno depth showempty ts
summaryts' summaryts'
| showempty = summaryts | showempty = summaryts
| otherwise = filter (not . isZeroMixedAmount . amount) summaryts | otherwise = filter (not . isZeroMixedAmount . amount) summaryts
-- aggregate balances by account, like cacheLedger: txnanames = sort $ nub $ map account ts
anames = sort $ nub $ map account ts
allnames = expandAccountNames anames ++ [""] -- aggregate balances by account like cacheLedger
-- from cacheLedger: ant = accountNameTreeFrom txnanames
txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allnames]) anames = flatten ant
txnsof = (txnmap !) -- a's txns txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- anames])
isunder a b = null a || a `isAccountNamePrefixOf` b txnsof = (txnmap !)
subacctsof a = filter (isunder a) anames -- a plus any subaccounts addbalances :: Tree AccountName -> Tree (AccountName, MixedAmount)
subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a] -- a's and subaccounts' txns addbalances (Node a []) = Node (a,sumTransactions $ txnsof a) []
inclusivebalmap = Map.union -- subaccount-including balances for all accounts addbalances (Node a subs) = Node (a,sumtxns + sumsubaccts) subbals
(Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- allnames]) where
(Map.fromList [(a,Mixed []) | a <- anames]) sumtxns = sumTransactions $ txnsof a
-- sumsubaccts = sum $ map (snd . root) subbals
-- then do depth-clipping subbals = map addbalances subs
exclusivebalmap = Map.union -- subaccount-excluding balances for all accounts inclbalmap = Map.fromList $ flatten $ addbalances ant
(Map.fromList [(a,(sumTransactions $ txnsof a)) | a <- allnames]) inclbalof = (inclbalmap !)
(Map.fromList [(a,Mixed []) | a <- anames])
inclusivebalanceof = (inclusivebalmap !) -- and do depth-clipping
exclusivebalanceof = (exclusivebalmap !) addexclbalances :: Tree AccountName -> Tree (AccountName, MixedAmount)
clippedanames = clipAccountNames depth anames addexclbalances (Node a subs) = Node (a,sumtxns) subbals
where
sumtxns = sumTransactions $ txnsof a
subbals = map addexclbalances subs
exclbalmap = Map.fromList $ flatten $ addexclbalances ant
exclbalof = (exclbalmap !)
clippedanames = clipAccountNames depth txnanames
isclipped a = accountNameLevel a >= fromMaybe 9999 depth isclipped a = accountNameLevel a >= fromMaybe 9999 depth
balancetoshowfor a = (if isclipped a then inclusivebalanceof else exclusivebalanceof) a balancetoshowfor a =
(if isclipped a then inclbalof else exclbalof) (if null a then "top" else a)
summaryts = [txn{account=a,amount=balancetoshowfor a} | a <- clippedanames] summaryts = [txn{account=a,amount=balancetoshowfor a} | a <- clippedanames]
clipAccountNames :: Maybe Int -> [AccountName] -> [AccountName] clipAccountNames :: Maybe Int -> [AccountName] -> [AccountName]