lib: speed up -V by sorting market prices just once (#999)

-V is still quite a bit slower than no -V, but not as much as before:

+===========================================================++=======+
| hledger.999.pre -f examples/10000x10000x10.journal bal    ||  5.20 |
| hledger.999.pre -f examples/10000x10000x10.journal bal -V || 57.20 |
| hledger.999 -f examples/10000x10000x10.journal bal        ||  5.34 |
| hledger.999 -f examples/10000x10000x10.journal bal -V     || 17.50 |
+-----------------------------------------------------------++-------+
This commit is contained in:
Simon Michael 2019-04-20 13:12:53 -07:00
parent 5911c73757
commit 028303acd7
4 changed files with 45 additions and 30 deletions

View File

@ -445,33 +445,37 @@ canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'}
s' = findWithDefault s c styles s' = findWithDefault s c styles
-- | Find the market value of this amount on the given date, in it's -- | Find the market value of this amount on the given date, in it's
-- default valuation commodity, based on recorded market prices. -- default valuation commodity, using the given market prices which
-- should be in date then parse order.
-- If no default valuation commodity can be found, the amount is left -- If no default valuation commodity can be found, the amount is left
-- unchanged. -- unchanged.
amountValue :: Journal -> Day -> Amount -> Amount amountValue :: MarketPricesDateAndParseOrdered -> Day -> Amount -> Amount
amountValue j d a = amountValue ps d a@Amount{acommodity=c} =
case commodityValue j d (acommodity a) of let ps' = filter ((c==).mpcommodity) ps
Just v -> v{aquantity=aquantity v * aquantity a} in
Nothing -> a case commodityValue ps' d c of
Just v -> v{aquantity=aquantity v * aquantity a}
Nothing -> a
-- This is here not in Commodity.hs to use the Amount Show instance above for debugging. -- (This is here not in Commodity.hs to use the Amount Show instance above for debugging.)
-- | Find the market value, if known, of one unit of this commodity (A) on --
-- the given valuation date, in the commodity (B) mentioned in the latest -- | Find the market value, if known, of one unit of the given
-- applicable market price. The latest applicable market price is the market -- commodity (A), on the given valuation date, in the commodity (B)
-- price directive for commodity A with the latest date that is on or before -- mentioned in the latest applicable market price.
-- the valuation date; or if there are multiple such prices with the same date, --
-- the last parsed. -- The applicable price is obtained from the given market prices,
commodityValue :: Journal -> Day -> CommoditySymbol -> Maybe Amount -- which should be for commodity A only, and in date then parse order.
commodityValue j valuationdate c -- It is the price with the latest date on or before the valuation
| null applicableprices = dbg Nothing -- date; or if there are multiple prices on that date, the last one
| otherwise = dbg $ Just $ mpamount $ last applicableprices -- parsed.
--
commodityValue :: CommodityPricesDateAndParseOrdered -> Day -> CommoditySymbol -> Maybe Amount
commodityValue ps valuationdate c =
case filter ((<=valuationdate).mpdate) ps of
[] -> dbg Nothing
ps' -> dbg $ Just $ mpamount $ last ps'
where where
dbg = dbg8 ("using market price for "++T.unpack c) dbg = dbg8 ("using market price for "++T.unpack c)
applicableprices =
[p | p <- sortOn mpdate $ jmarketprices j
, mpcommodity p == c
, mpdate p <= valuationdate
]
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
@ -727,8 +731,8 @@ cshowMixedAmountOneLineWithoutPrice m = intercalate ", " $ map cshowAmountWithou
canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styles) as canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styles) as
mixedAmountValue :: Journal -> Day -> MixedAmount -> MixedAmount mixedAmountValue :: MarketPricesDateAndParseOrdered -> Day -> MixedAmount -> MixedAmount
mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) as mixedAmountValue ps d (Mixed as) = Mixed $ map (amountValue ps d) as
-- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice. -- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice.
-- Has no effect on amounts without one. -- Has no effect on amounts without one.

View File

@ -233,7 +233,7 @@ addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction pt j = j { jperiodictxns = pt : jperiodictxns j } addPeriodicTransaction pt j = j { jperiodictxns = pt : jperiodictxns j }
addMarketPrice :: MarketPrice -> Journal -> Journal addMarketPrice :: MarketPrice -> Journal -> Journal
addMarketPrice h j = j { jmarketprices = h : jmarketprices j } addMarketPrice h j = j { jmarketprices = h : jmarketprices j } -- XXX #999 keep sorted
-- | Get the transaction with this index (its 1-based position in the input stream), if any. -- | Get the transaction with this index (its 1-based position in the input stream), if any.
journalTransactionAt :: Journal -> Integer -> Maybe Transaction journalTransactionAt :: Journal -> Integer -> Maybe Transaction
@ -527,9 +527,9 @@ filterJournalTransactionsByAccount apats j@Journal{jtxns=ts} = j{jtxns=filter tm
-} -}
-- | Reverse parsed data to normal order. This is used for post-parse -- | Reverse all lists of parsed items, which during parsing were
-- processing, since data is added to the head of the list during -- prepended to, so that the items are in parse order. Part of
-- parsing. -- post-parse finalisation.
journalReverse :: Journal -> Journal journalReverse :: Journal -> Journal
journalReverse j = journalReverse j =
j {jfiles = reverse $ jfiles j j {jfiles = reverse $ jfiles j

View File

@ -428,6 +428,15 @@ data MarketPrice = MarketPrice {
instance NFData MarketPrice instance NFData MarketPrice
-- | Market prices in the order they were declared in the parse stream.
type MarketPricesParseOrdered = [MarketPrice]
-- | Market prices in date then parse order.
type MarketPricesDateAndParseOrdered = [MarketPrice]
-- | Market prices for a single commodity, in date then parse order.
type CommodityPricesDateAndParseOrdered = [MarketPrice]
-- | A Journal, containing transactions and various other things. -- | A Journal, containing transactions and various other things.
-- The basic data model for hledger. -- The basic data model for hledger.
-- --
@ -452,7 +461,8 @@ data Journal = Journal {
,jdeclaredaccounttypes :: M.Map AccountType [AccountName] -- ^ Accounts whose type has been declared in account directives (usually 5 top-level accounts) ,jdeclaredaccounttypes :: M.Map AccountType [AccountName] -- ^ Accounts whose type has been declared in account directives (usually 5 top-level accounts)
,jcommodities :: M.Map CommoditySymbol Commodity -- ^ commodities and formats declared by commodity directives ,jcommodities :: M.Map CommoditySymbol Commodity -- ^ commodities and formats declared by commodity directives
,jinferredcommodities :: M.Map CommoditySymbol AmountStyle -- ^ commodities and formats inferred from journal amounts TODO misnamed - jusedstyles ,jinferredcommodities :: M.Map CommoditySymbol AmountStyle -- ^ commodities and formats inferred from journal amounts TODO misnamed - jusedstyles
,jmarketprices :: [MarketPrice] ,jmarketprices :: MarketPricesParseOrdered -- ^ All market prices declared by P directives, in parse order (after journal finalisation).
-- Note, not yet in date order because concatenating journals could mess that up.
,jtxnmodifiers :: [TransactionModifier] ,jtxnmodifiers :: [TransactionModifier]
,jperiodictxns :: [PeriodicTransaction] ,jperiodictxns :: [PeriodicTransaction]
,jtxns :: [Transaction] ,jtxns :: [Transaction]

View File

@ -128,7 +128,8 @@ journalApplyValue ropts j = do
today <- getCurrentDay today <- getCurrentDay
mspecifiedenddate <- specifiedEndDate ropts mspecifiedenddate <- specifiedEndDate ropts
let d = fromMaybe today mspecifiedenddate let d = fromMaybe today mspecifiedenddate
convert | value_ ropts = overJournalAmounts (amountValue j d) ps = sortOn mpdate $ jmarketprices j
convert | value_ ropts = overJournalAmounts (amountValue ps d)
| otherwise = id | otherwise = id
return $ convert j return $ convert j