From 91735f4f3c93e5c42b4a0526a51fd32cca3d96ad Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 2 Jul 2007 23:41:07 +0000 Subject: [PATCH] begin optimization --- Account.hs | 5 +- AccountName.hs | 7 ++- Entry.hs | 4 +- EntryTransaction.hs | 25 ++++++++-- Ledger.hs | 109 ++++++++++++++++++++++++++++++++++---------- NOTES | 72 ++++++++++++++++++++++++++++- RawLedger.hs | 5 +- Types.hs | 2 +- Utils.hs | 1 + 9 files changed, 185 insertions(+), 45 deletions(-) diff --git a/Account.hs b/Account.hs index 6de165fd7..e94bd7865 100644 --- a/Account.hs +++ b/Account.hs @@ -12,14 +12,12 @@ import EntryTransaction import RawLedger --- an Account caches an account's name, balance (including sub-accounts) --- and transactions (excluding sub-accounts) - instance Show Account where show (Account a ts b) = printf "Account %s with %d transactions" a $ length ts nullacct = Account "" [] nullamt +-- XXX SLOW rawLedgerAccount :: RawLedger -> AccountName -> Account rawLedgerAccount l a = Account @@ -133,6 +131,7 @@ rawLedgerAccountTreeMatching l acctpats showsubs maxdepth = showAccountTree :: RawLedger -> Tree Account -> String showAccountTree l = showAccountTree' l 0 . interestingAccountsFrom +showAccountTree' :: RawLedger -> Int -> Tree Account -> String showAccountTree' l indentlevel t -- if this acct is boring, don't show it | isBoringInnerAccount l acct = subacctsindented 0 diff --git a/AccountName.hs b/AccountName.hs index a4ba26886..e86277e4a 100644 --- a/AccountName.hs +++ b/AccountName.hs @@ -3,9 +3,6 @@ where import Utils import Types --- AccountNames are strings like "assets:cash:petty"; from these we build --- the chart of accounts, which should be a simple hierarchy. - accountNameComponents :: AccountName -> [String] accountNameComponents = splitAtElement ':' @@ -36,8 +33,10 @@ parentAccountNames a = parentAccountNames' $ parentAccountName a parentAccountNames' "" = [] parentAccountNames' a = [a] ++ (parentAccountNames' $ parentAccountName a) +p `isAccountNamePrefixOf` s = ((p ++ ":") `isPrefixOf` s) + s `isSubAccountNameOf` p = - ((p ++ ":") `isPrefixOf` s) && (accountNameLevel s == (accountNameLevel p + 1)) + (p `isAccountNamePrefixOf` s) && (accountNameLevel s == (accountNameLevel p + 1)) subAccountNamesFrom :: [AccountName] -> AccountName -> [AccountName] subAccountNamesFrom accts a = filter (`isSubAccountNameOf` a) accts diff --git a/Entry.hs b/Entry.hs index 6135a089e..b0974ce4d 100644 --- a/Entry.hs +++ b/Entry.hs @@ -6,6 +6,8 @@ import Types import Transaction +instance Show Entry where show = showEntry + -- a register entry is displayed as two or more lines like this: -- date description account amount balance -- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA @@ -17,8 +19,6 @@ import Transaction -- amtWidth = 11 -- balWidth = 12 -instance Show Entry where show = showEntry - showEntry e = (showDate $ edate e) ++ " " ++ (showDescription $ edescription e) ++ " " showDate d = printf "%-10s" d showDescription s = printf "%-20s" (elideRight 20 s) diff --git a/EntryTransaction.hs b/EntryTransaction.hs index 9b631a651..dc37c0fd1 100644 --- a/EntryTransaction.hs +++ b/EntryTransaction.hs @@ -3,17 +3,13 @@ module EntryTransaction where import Utils import Types +import AccountName import Entry import Transaction import Amount import Currency --- We convert Transactions into EntryTransactions, which are (entry, --- transaction) pairs, since I couldn't see how to have transactions --- reference their entry like in OO. These are referred to as just --- "transactions" in code above. - entry (e,t) = e transaction (e,t) = t date (e,t) = edate e @@ -26,6 +22,9 @@ amount (e,t) = tamount t flattenEntry :: Entry -> [EntryTransaction] flattenEntry e = [(e,t) | t <- etransactions e] +accountNamesFromTransactions :: [EntryTransaction] -> [AccountName] +accountNamesFromTransactions ts = nub $ map account ts + entryTransactionsFrom :: [Entry] -> [EntryTransaction] entryTransactionsFrom es = concat $ map flattenEntry es @@ -70,3 +69,19 @@ showTransactionAndBalance t b = showBalance :: Amount -> String showBalance b = printf " %12s" (showAmountRoundedOrZero b) +transactionsMatching :: ([String],[String]) -> [EntryTransaction] -> [EntryTransaction] +transactionsMatching ([],[]) ts = transactionsMatching ([".*"],[".*"]) ts +transactionsMatching (rs,[]) ts = transactionsMatching (rs,[".*"]) ts +transactionsMatching ([],rs) ts = transactionsMatching ([".*"],rs) ts +transactionsMatching (acctregexps,descregexps) ts = + intersect + (concat [filter (matchTransactionAccount r) ts | r <- acctregexps]) + (concat [filter (matchTransactionDescription r) ts | r <- descregexps]) + +transactionsWithAccountName :: AccountName -> [EntryTransaction] -> [EntryTransaction] +transactionsWithAccountName a ts = [t | t <- ts, account t == a] + +transactionsWithOrBelowAccountName :: AccountName -> [EntryTransaction] -> [EntryTransaction] +transactionsWithOrBelowAccountName a ts = + [t | t <- ts, account t == a || a `isAccountNamePrefixOf` (account t)] + diff --git a/Ledger.hs b/Ledger.hs index 5322ac3cb..3df082981 100644 --- a/Ledger.hs +++ b/Ledger.hs @@ -1,6 +1,7 @@ module Ledger where import qualified Data.Map as Map +import Data.Map ((!)) import Utils import Types @@ -12,38 +13,98 @@ import RawLedger cacheLedger :: RawLedger -> Ledger cacheLedger l = - Ledger - l - (rawLedgerAccountNameTree l) - (Map.fromList [(a, rawLedgerAccount l a) | a <- rawLedgerAccountNames l]) + let + ant = rawLedgerAccountNameTree l + ans = flatten ant + ts = rawLedgerTransactions l + amap = Map.fromList [ + (a, + Account a + (transactionsWithAccountName a ts) + (sumEntryTransactions $ transactionsWithOrBelowAccountName a ts) + ) | a <- ans] + in + Ledger l ant amap + +ledgerAccount :: Ledger -> AccountName -> Account +-- wtf ledgerAccount l = ((accounts l) (!)) +ledgerAccount l aname = head [a | (n,a) <- Map.toList $ accounts l, n == aname] ledgerTransactions :: Ledger -> [EntryTransaction] ledgerTransactions l = concatMap atransactions $ Map.elems $ accounts l --- unoptimised +-- XXX optimise ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction] ledgerTransactionsMatching pats l = rawLedgerTransactionsMatching pats $ rawledger l --- XXX optimise -ledgerTransactionsMatching1 :: ([String],[String]) -> Ledger -> [EntryTransaction] -ledgerTransactionsMatching1 ([],[]) l = rawLedgerTransactionsMatching ([".*"],[".*"]) (rawledger l) -ledgerTransactionsMatching1 (rs,[]) l = rawLedgerTransactionsMatching (rs,[".*"]) (rawledger l) -ledgerTransactionsMatching1 ([],rs) l = rawLedgerTransactionsMatching ([".*"],rs) (rawledger l) -ledgerTransactionsMatching1 (acctregexps,descregexps) l = - intersect - (concat [filter (matchTransactionAccount r) ts | r <- acctregexps]) - (concat [filter (matchTransactionDescription r) ts | r <- descregexps]) - where ts = ledgerTransactions l - --- unoptimised +-- XXX optimise (in progress) showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String showLedgerAccounts l acctpats showsubs maxdepth = - showRawLedgerAccounts (rawledger l) acctpats showsubs maxdepth - --- XXX optimise -showLedgerAccounts1 :: Ledger -> [String] -> Bool -> Int -> String -showLedgerAccounts1 l acctpats showsubs maxdepth = concatMap - (showAccountTree (rawledger l)) - (branches (rawLedgerAccountTreeMatching (rawledger l) acctpats showsubs maxdepth)) + (showAccountTree2 l) + (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth)) + +showAccountTree2 :: Ledger -> Tree Account -> String +showAccountTree2 l = showAccountTree'2 l 0 . interestingAccountsFrom + +showAccountTree'2 :: Ledger -> Int -> Tree Account -> String +showAccountTree'2 l indentlevel t + -- if this acct is boring, don't show it + | isBoringInnerAccount2 l acct = subacctsindented 0 + -- otherwise show normal indented account name with balance, + -- prefixing the names of any boring parents + | otherwise = + bal ++ " " ++ indent ++ prefix ++ leafname ++ "\n" ++ (subacctsindented 1) + where + acct = root t + subacctsindented i = concatMap (showAccountTree'2 l (indentlevel+i)) $ branches t + bal = printf "%20s" $ show $ abalance $ acct + indent = replicate (indentlevel * 2) ' ' + prefix = concatMap (++ ":") $ map accountLeafName boringparents + boringparents = takeWhile (isBoringInnerAccountName2 l) $ parentAccountNames $ aname acct + leafname = accountLeafName $ aname acct + +isBoringInnerAccount2 :: Ledger -> Account -> Bool +isBoringInnerAccount2 l a + | name == "top" = False + | (length txns == 0) && ((length subs) == 1) = True + | otherwise = False + where + name = aname a + txns = atransactions a + subs = subAccountNamesFrom (accountnames l) name + +accountnames :: Ledger -> [AccountName] +accountnames l = flatten $ accountnametree l + +isBoringInnerAccountName2 :: Ledger -> AccountName -> Bool +isBoringInnerAccountName2 l name + | name == "top" = False + | (length txns == 0) && ((length subs) == 1) = True + | otherwise = False + where + txns = transactionsInAccountNamed2 l name + subs = subAccountNamesFrom (rawLedgerAccountNames (rawledger l)) name + +transactionsInAccountNamed2 :: Ledger -> AccountName -> [EntryTransaction] +transactionsInAccountNamed2 l a = atransactions $ ledgerAccount l a + +---- + +ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account +ledgerAccountTreeMatching l [] showsubs maxdepth = + ledgerAccountTreeMatching l [".*"] showsubs maxdepth +ledgerAccountTreeMatching l acctpats showsubs maxdepth = + addDataToAccountNameTree2 l $ + filterAccountNameTree acctpats showsubs maxdepth $ + accountnametree l + +addDataToAccountNameTree2 :: Ledger -> Tree AccountName -> Tree Account +addDataToAccountNameTree2 l ant = + Node + (ledgerAccount l $ root ant) + (map (addDataToAccountNameTree2 l) $ branches ant) + +-- ledgerAccountNames :: Ledger -> [AccountName] +-- ledgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed diff --git a/NOTES b/NOTES index 1995743a2..5856bd0d1 100644 --- a/NOTES +++ b/NOTES @@ -10,11 +10,79 @@ hledger project notes *********** description EntryTransaction 48 0.0 0.0 0.0 0.0 ********** matchTransactionAccount EntryTransaction 864 66.7 7.3 66.7 7.3 *********** account EntryTransaction 864 0.0 0.0 0.0 0.0 - -**** with cachedledger, unoptimised +**** cachedledger added matchTransactionAccount EntryTransaction 619 86602 13.4 2.4 13.5 2.4 matchTransactionAccount EntryTransaction 558 91637 22.8 2.8 22.9 2.8 matchTransactionAccount EntryTransaction 520 91637 16.8 2.6 16.9 2.6 +**** functions renamed + balance Main 334 1 0.0 0.0 99.6 97.4 + showLedgerAccounts Ledger 460 1 0.0 0.0 99.6 97.3 + showRawLedgerAccounts Account 461 1 0.1 0.0 99.6 97.3 + showAccountTree Account 505 1 0.0 0.0 31.6 37.3 + showAccountTree' Account 506 91 0.0 0.0 31.6 37.3 + isBoringInnerAccountName Account 613 86 0.1 0.0 29.4 31.1 + transactionsInAccountNamed Account 614 86 0.0 0.0 17.3 4.3 + rawLedgerTransactionsMatching RawLedger 615 172 0.7 0.7 17.3 4.3 + matchTransactionAccount EntryTransaction 619 86602 14.8 2.4 14.9 2.4 +> rawLedgerAccountTreeMatching Account 463 2 0.0 0.0 67.9 60.0 +> addDataToAccountNameTree Account 465 93 0.0 0.0 67.7 59.8 +> rawLedgerAccount Account 512 92 0.0 0.0 67.7 59.8 +> transactionsInAccountNamed Account 515 91 0.0 0.0 29.0 20.0 +> rawLedgerTransactionsMatching RawLedger 516 182 3.6 13.9 29.0 20.0 +> matchTransactionAccount EntryTransaction 520 91637 17.1 2.6 17.2 2.6 + aggregateBalanceInAccountNamed Account 550 91 0.0 0.0 38.7 39.8 + aggregateTransactionsInAccountNamed Account 553 91 0.0 0.0 38.7 39.8 + rawLedgerTransactionsMatching RawLedger 554 182 7.3 32.8 38.7 39.7 + matchTransactionAccount EntryTransaction 558 91637 22.6 2.8 22.8 2.8 + +1 +showRawLedgerAccounts l acctpats showsubs maxdepth = + concatMap + (showAccountTree l) + (branches (rawLedgerAccountTreeMatching l acctpats showsubs maxdepth)) + +2 +rawLedgerAccountTreeMatching l [] showsubs maxdepth = + rawLedgerAccountTreeMatching l [".*"] showsubs maxdepth +rawLedgerAccountTreeMatching l acctpats showsubs maxdepth = + addDataToAccountNameTree l $ + filterAccountNameTree acctpats showsubs maxdepth $ + rawLedgerAccountNameTree l + +93 +addDataToAccountNameTree l ant = + Node + (rawLedgerAccount l $ root ant) + (map (addDataToAccountNameTree l) $ branches ant) + +92 +rawLedgerAccount l a = + Account + a + (transactionsInAccountNamed l a) + (aggregateBalanceInAccountNamed l a) + +91 +transactionsInAccountNamed l a = + rawLedgerTransactionsMatching (["^" ++ a ++ "$"], []) l + +182 +rawLedgerTransactionsMatching ([],[]) l = rawLedgerTransactionsMatching ([".*"],[".*"]) l +rawLedgerTransactionsMatching (rs,[]) l = rawLedgerTransactionsMatching (rs,[".*"]) l +rawLedgerTransactionsMatching ([],rs) l = rawLedgerTransactionsMatching ([".*"],rs) l +rawLedgerTransactionsMatching (acctregexps,descregexps) l = + intersect + (concat [filter (matchTransactionAccount r) ts | r <- acctregexps]) + (concat [filter (matchTransactionDescription r) ts | r <- descregexps]) + where ts = rawLedgerTransactions l + +91637 +matchTransactionAccount s t = + case matchRegex (mkRegex s) (account t) of + Nothing -> False + otherwise -> True + +**** begin optimisation ** make some decent tests ** bugs *** space after account makes it a new account diff --git a/RawLedger.hs b/RawLedger.hs index 28ea946ab..d1c986a55 100644 --- a/RawLedger.hs +++ b/RawLedger.hs @@ -3,8 +3,8 @@ where import qualified Data.Map as Map import Utils -import AccountName import Types +import AccountName import Entry import EntryTransaction @@ -31,9 +31,6 @@ rawLedgerTransactionsMatching (acctregexps,descregexps) l = rawLedgerAccountTransactions :: RawLedger -> AccountName -> [EntryTransaction] rawLedgerAccountTransactions l a = rawLedgerTransactionsMatching (["^" ++ a ++ "$"], []) l -accountNamesFromTransactions :: [EntryTransaction] -> [AccountName] -accountNamesFromTransactions ts = nub $ map account ts - rawLedgerAccountNamesUsed :: RawLedger -> [AccountName] rawLedgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l diff --git a/Types.hs b/Types.hs index c201b3762..ecddd0a75 100644 --- a/Types.hs +++ b/Types.hs @@ -114,7 +114,7 @@ data Account = Account { -- a ledger with account info cached for faster queries data Ledger = Ledger { rawledger :: RawLedger, - accountnames :: Tree AccountName, + accountnametree :: Tree AccountName, accounts :: Map.Map AccountName Account } diff --git a/Utils.hs b/Utils.hs index ad412829f..19d9e8df6 100644 --- a/Utils.hs +++ b/Utils.hs @@ -28,6 +28,7 @@ splitAtElement e l = -- tree tools +-- aliases root = rootLabel branches = subForest