From 028303acd7d9bdfe20169775a1209628ef0e6d0b Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sat, 20 Apr 2019 13:12:53 -0700 Subject: [PATCH] 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 | +-----------------------------------------------------------++-------+ --- hledger-lib/Hledger/Data/Amount.hs | 52 ++++++++++++++++------------- hledger-lib/Hledger/Data/Journal.hs | 8 ++--- hledger-lib/Hledger/Data/Types.hs | 12 ++++++- hledger/Hledger/Cli/Utils.hs | 3 +- 4 files changed, 45 insertions(+), 30 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 370b53822..7b69f3a31 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -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. diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 5e4fa9f04..9772e2547 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index d20832826..257662b1f 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -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] diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index bdf996b71..9a730f736 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -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