lib: remove needless numeric comparisons in bal/bs

accountsFromPostings is currently doing excessive work when adding up
postings in each account. It sorts (accountName, amount) tuples which
cause amounts in them to be compared. There is no need to look at amount
here at all since subsequent summing up and counting does not depend on
order. It is enough to sort by accountname only.

Went through similar pieces of code, made them all look uniform.
This commit is contained in:
Dmitry Astapov 2017-11-28 01:22:44 +00:00 committed by Simon Michael
parent cf0dfa9f58
commit 6f92e70575
2 changed files with 7 additions and 7 deletions

View File

@ -10,6 +10,7 @@ account, and subaccounting-excluding and -including balances.
module Hledger.Data.Account module Hledger.Data.Account
where where
import Data.List import Data.List
import Data.List.Extra (groupSort, groupOn)
import Data.Maybe import Data.Maybe
import Data.Ord import Data.Ord
import qualified Data.Map as M import qualified Data.Map as M
@ -63,10 +64,9 @@ nullacct = Account
accountsFromPostings :: [Posting] -> [Account] accountsFromPostings :: [Posting] -> [Account]
accountsFromPostings ps = accountsFromPostings ps =
let let
acctamts = [(paccount p,pamount p) | p <- ps] grouped = groupSort [(paccount p,pamount p) | p <- ps]
grouped = groupBy (\a b -> fst a == fst b) $ sort $ acctamts counted = [(aname, length amts) | (aname, amts) <- grouped]
counted = [(a, length acctamts) | acctamts@((a,_):_) <- grouped] summed = [(aname, sumStrict amts) | (aname, amts) <- grouped] -- always non-empty
summed = map (\as@((aname,_):_) -> (aname, sumStrict $ map snd as)) grouped -- always non-empty
nametree = treeFromPaths $ map (expandAccountName . fst) summed nametree = treeFromPaths $ map (expandAccountName . fst) summed
acctswithnames = nameTreeToAccount "root" nametree acctswithnames = nameTreeToAccount "root" nametree
acctswithnumps = mapAccounts setnumps acctswithnames where setnumps a = a{anumpostings=fromMaybe 0 $ lookup (aname a) counted} acctswithnumps = mapAccounts setnumps acctswithnames where setnumps a = a{anumpostings=fromMaybe 0 $ lookup (aname a) counted}
@ -132,7 +132,7 @@ clipAccountsAndAggregate d as = combined
where where
clipped = [a{aname=clipOrEllipsifyAccountName d $ aname a} | a <- as] clipped = [a{aname=clipOrEllipsifyAccountName d $ aname a} | a <- as]
combined = [a{aebalance=sum (map aebalance same)} combined = [a{aebalance=sum (map aebalance same)}
| same@(a:_) <- groupBy (\a1 a2 -> aname a1 == aname a2) clipped] | same@(a:_) <- groupOn aname clipped]
{- {-
test cases, assuming d=1: test cases, assuming d=1:

View File

@ -75,6 +75,7 @@ import Data.Array.ST
import Data.Functor.Identity (Identity(..)) import Data.Functor.Identity (Identity(..))
import qualified Data.HashTable.ST.Cuckoo as HT import qualified Data.HashTable.ST.Cuckoo as HT
import Data.List import Data.List
import Data.List.Extra (groupSort)
-- import Data.Map (findWithDefault) -- import Data.Map (findWithDefault)
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
@ -752,8 +753,7 @@ journalInferCommodityStyles j =
commodityStylesFromAmounts :: [Amount] -> M.Map CommoditySymbol AmountStyle commodityStylesFromAmounts :: [Amount] -> M.Map CommoditySymbol AmountStyle
commodityStylesFromAmounts amts = M.fromList commstyles commodityStylesFromAmounts amts = M.fromList commstyles
where where
samecomm = \a1 a2 -> acommodity a1 == acommodity a2 commamts = groupSort [(acommodity as, as) | as <- amts]
commamts = [(acommodity $ head as, as) | as <- groupBy samecomm $ sortBy (comparing acommodity) amts]
commstyles = [(c, canonicalStyleFrom $ map astyle as) | (c,as) <- commamts] commstyles = [(c, canonicalStyleFrom $ map astyle as) | (c,as) <- commamts]
-- | Given an ordered list of amount styles, choose a canonical style. -- | Given an ordered list of amount styles, choose a canonical style.