slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

begin optimization

Browse Source
This commit is contained in:
Simon Michael 2007-07-02 23:41:07 +00:00
parent 362d3831ea
commit 91735f4f3c
9 changed files with 185 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Account.hs
View File

@ -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

7
AccountName.hs
View File

@ -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

4
Entry.hs
View File

@ -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)

25
EntryTransaction.hs
View File

@ -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)]

109
Ledger.hs
View File

@ -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

72
NOTES
View File

@ -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

5
RawLedger.hs
View File

@ -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

2
Types.hs
View File

@ -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
}

1
Utils.hs
View File

@ -28,6 +28,7 @@ splitAtElement e l =
-- tree tools
-- aliases
root = rootLabel
branches = subForest