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
-- | 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
-- unchanged.
amountValue :: Journal -> Day -> Amount -> Amount
amountValue j d a =
case commodityValue j d (acommodity a) of
Just v -> v{aquantity=aquantity v * aquantity a}
Nothing -> a
amountValue :: MarketPricesDateAndParseOrdered -> Day -> Amount -> Amount
amountValue ps d a@Amount{acommodity=c} =
let ps' = filter ((c==).mpcommodity) ps
in
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.
-- | 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
-- applicable market price. The latest applicable market price is the market
-- price directive for commodity A with the latest date that is on or before
-- the valuation date; or if there are multiple such prices with the same date,
-- the last parsed.
commodityValue :: Journal -> Day -> CommoditySymbol -> Maybe Amount
commodityValue j valuationdate c
| null applicableprices = dbg Nothing
| otherwise = dbg $ Just $ mpamount $ last applicableprices
-- (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 the given
-- commodity (A), on the given valuation date, in the commodity (B)
-- mentioned in the latest applicable market price.
--
-- The applicable price is obtained from the given market prices,
-- which should be for commodity A only, and in date then parse order.
-- It is the price with the latest date on or before the valuation
-- date; or if there are multiple prices on that date, the last one
-- 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
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 styles (Mixed as) = Mixed $ map (canonicaliseAmount styles) as
mixedAmountValue :: Journal -> Day -> MixedAmount -> MixedAmount
mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) as
mixedAmountValue :: MarketPricesDateAndParseOrdered -> Day -> MixedAmount -> MixedAmount
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.
-- 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 }
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.
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
-- processing, since data is added to the head of the list during
-- parsing.
-- | Reverse all lists of parsed items, which during parsing were
-- prepended to, so that the items are in parse order. Part of
-- post-parse finalisation.
journalReverse :: Journal -> Journal
journalReverse j =
j {jfiles = reverse $ jfiles j

View File

@ -428,6 +428,15 @@ data MarketPrice = 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.
-- 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)
,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
,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]
,jperiodictxns :: [PeriodicTransaction]
,jtxns :: [Transaction]

View File

@ -128,7 +128,8 @@ journalApplyValue ropts j = do
today <- getCurrentDay
mspecifiedenddate <- specifiedEndDate ropts
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
return $ convert j