diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index 7c96cc2f2..64a4a830f 100644 --- a/hledger-lib/Hledger/Data/Valuation.hs +++ b/hledger-lib/Hledger/Data/Valuation.hs @@ -28,19 +28,18 @@ module Hledger.Data.Valuation ( where import Control.Applicative ((<|>)) -import Data.Decimal (roundTo) +import Data.Foldable (asum) import Data.Function ((&), on) -import Data.Graph.Inductive (Gr, Node, NodeMap, mkMapGraph, mkNode, lab, out, sp) -import Data.List +import Data.List ( (\\), sortBy ) import Data.List.Extra (nubSortBy) import qualified Data.Map as M import qualified Data.Set as S -import Data.Maybe +import Data.Maybe ( fromMaybe ) import qualified Data.Text as T import Data.Time.Calendar (Day, fromGregorian) import Data.MemoUgly (memo) import GHC.Generics (Generic) -import Safe (headMay) +import Safe (lastMay) import Hledger.Utils import Hledger.Data.Types @@ -62,31 +61,6 @@ data ValuationType = | AtDefault (Maybe CommoditySymbol) -- ^ works like AtNow in single period reports, like AtEnd in multiperiod reports deriving (Show,Eq) --- | A snapshot of the known exchange rates between commodity pairs at a given date, --- as a graph allowing fast lookup and path finding, along with some helper data. -data PriceGraph = PriceGraph { - prGraph :: Gr CommoditySymbol Quantity - -- ^ A directed graph of exchange rates between commodity pairs. - -- Node labels are commodities and edge labels are exchange rates, - -- which were either: - -- declared by P directives, - -- inferred from transaction prices, - -- inferred by reversing a declared rate, - -- or inferred by reversing a transaction-inferred rate. - -- There will be at most one edge between each directed pair of commodities, - -- eg there can be one USD->EUR and one EUR->USD. - ,prNodemap :: NodeMap CommoditySymbol - -- ^ Mapping of graph node ids to commodity symbols. - ,prDefaultValuationCommodities :: M.Map CommoditySymbol CommoditySymbol - -- ^ The default valuation commodity for each source commodity. - -- These are used when a valuation commodity is not specified - -- (-V). They are the destination commodity of the latest - -- (declared or inferred, but not reverse) each - -- source commodity's latest market price (on the date of this - -- graph). - } - deriving (Show,Generic) - -- | A price oracle is a magic memoising function that efficiently -- looks up market prices (exchange rates) from one commodity to -- another (or if unspecified, to a default valuation commodity) on a @@ -229,11 +203,11 @@ priceLookup :: (Day -> PriceGraph) -> Day -> CommoditySymbol -> Maybe CommodityS priceLookup makepricegraph d from mto = -- trace ("priceLookup ("++show d++", "++show from++", "++show mto++")") $ let - -- build a graph of the commodity exchange rates in effect on this day - -- XXX should hide these fgl details better - PriceGraph{prGraph=g, prNodemap=m, prDefaultValuationCommodities=defaultdests} = + PriceGraph{pgEdges=forwardprices + ,pgEdgesRev=allprices + ,pgDefaultValuationCommodities=defaultdests + } = traceAt 1 ("valuation date: "++show d) $ makepricegraph d - fromnode = node m from mto' = mto <|> mdefaultto where mdefaultto = dbg1 ("default valuation commodity for "++T.unpack from) $ @@ -243,25 +217,15 @@ priceLookup makepricegraph d from mto = Nothing -> Nothing Just to | to==from -> Nothing Just to -> - -- We have a commodity to convert to. Find the most direct price available. - case mindirectprice of + -- We have a commodity to convert to. Find the most direct price available, + -- according to the rules described in makePriceGraph. + case + pricesShortestPath forwardprices from to <|> + pricesShortestPath allprices from to + of Nothing -> Nothing - Just q -> Just (to, q) - where - tonode = node m to - mindirectprice :: Maybe Quantity = - -- Find the shortest path, if any, between from and to. - case dbg9 "shortest price path" $ sp fromnode tonode g :: Maybe [Node] of - Nothing -> Nothing - Just nodes -> - dbg ("market price for "++intercalate " -> " (map T.unpack comms)) $ - -- TODO: it would be nice to include price date as part of the label - -- in PriceGraph, so we could show the dates of market prices here - Just $ product $ pathEdgeLabels g nodes -- convert to a single exchange rate - where comms = catMaybes $ map (lab g) nodes - - -- log a message and a Maybe Quantity, hiding Just/Nothing and limiting decimal places - dbg msg = dbg1With (((msg++": ")++) . maybe "" (show . roundTo 8)) + Just [] -> Nothing + Just ps -> Just (mpto $ last ps, product $ map mprate ps) tests_priceLookup = let @@ -280,13 +244,85 @@ tests_priceLookup = priceLookup makepricegraph (fromGregorian 2000 01 01) "B" (Just "A") @?= Just ("A",0.1) priceLookup makepricegraph (fromGregorian 2000 01 01) "A" (Just "E") @?= Just ("E",500) +------------------------------------------------------------------------------ +-- Market price graph + +type Edge = MarketPrice +type Path = [Edge] + +data PriceGraph = PriceGraph { + pgDate :: Day + -- ^ The date on which these prices are in effect. + ,pgEdges :: [Edge] + -- ^ "Forward" exchange rates between commodity pairs, either + -- declared by P directives or inferred from transaction prices, + -- forming the edges of a directed graph. + ,pgEdgesRev :: [Edge] + -- ^ The same edges, plus any additional edges that can be + -- inferred by reversing them and inverting the rates. + -- + -- In both of these there will be at most one edge between each + -- directed pair of commodities, eg there can be one USD->EUR and one EUR->USD. + ,pgDefaultValuationCommodities :: M.Map CommoditySymbol CommoditySymbol + -- ^ The default valuation commodity for each source commodity. + -- These are used when a valuation commodity is not specified + -- (-V). They are the destination commodity of each source commodity's + -- latest (declared or inferred, but not reverse) market price + -- (on the date of this graph). + } + deriving (Show,Generic) + +-- | Find the shortest path and corresponding conversion rate, if any, +-- from one commodity to another using the provided market prices which +-- form the edges of a directed graph. There should be at most one edge +-- between each directed pair of commodities, eg there can be one +-- USD->EUR price and one EUR->USD price. +pricesShortestPath :: [Edge] -> CommoditySymbol -> CommoditySymbol -> Maybe Path +pricesShortestPath edges start end = + dbg1 ("shortest price path for "++T.unpack start++" -> "++T.unpack end) $ + asum $ map (findPath end edgesremaining) initialpaths + where + initialpaths = dbg9 "initial price paths" $ [[p] | p <- edges, mpfrom p == start] + edgesremaining = dbg9 "initial edges remaining" $ edges \\ concat initialpaths + +-- Helper: breadth-first search for a continuation of the given path +-- using zero or more of the given edges, to the specified end commodity. +-- Returns the first & shortest complete path found, or Nothing. +findPath :: CommoditySymbol -> [Edge] -> Path -> Maybe Path +findPath end _ path | mpathend == Just end = Just path -- path is complete + where + mpathend = mpto <$> lastMay path +findPath _ [] _ = Nothing -- no more edges are available +findPath end edgesremaining path = -- try continuing with all the remaining edges + asum [ + findPath end edgesremaining' path' + | e <- nextedges + , let path' = path++[e] + , let edgesremaining' = filter (/=e) edgesremaining + ] + where + nextedges = [ e | e <- edgesremaining, Just (mpfrom e) == mpathend ] + where + mpathend = mpto <$> lastMay path + +-- | A snapshot of the known exchange rates between commodity pairs at a given date. +-- This is a home-made version, more tailored to our needs. -- | Build the graph of commodity conversion prices for a given day. -- Converts a list of declared market prices in parse order, and a --- list of transaction-inferred market prices in parse order, to a --- graph of all known exchange rates between commodity pairs in effect --- on that day. Cf hledger.m4.md -> Valuation: +-- list of transaction-inferred market prices in parse order, to: -- --- hledger looks for a market price (exchange rate) from commodity A +-- 1. a graph of all known exchange rates declared or inferred from +-- one commodity to another in effect on that day +-- +-- 2. a second graph which includes any additional exchange rates +-- that can be inferred by reversing known rates +-- +-- 3. a map of each commodity's default valuation commodity, if any. +-- +-- These allow price lookup and valuation to be performed as +-- described in hledger.m4.md -> Valuation: +-- +-- "hledger looks for a market price (exchange rate) from commodity A -- to commodity B in one or more of these ways, in this order of -- preference: -- @@ -298,15 +334,15 @@ tests_priceLookup = -- 2. A *reverse market price*: -- the inverse of a declared or inferred market price from B to A. -- --- 3. A *chained market price*: --- a synthetic price formed by combining the shortest chain of market --- prices (any of the above types) leading from A to B. +-- 3. A *a forward chain of market prices*: +-- a synthetic price formed by combining the shortest chain of +-- "forward" (only 1 above) market prices, leading from A to B. -- --- 1 and 2 form the edges of the price graph, and we can query it for --- 3 (which is the reason we use a graph). +-- 4. A *any chain of market prices*: +-- a chain of any market prices, including both forward and +-- reverse prices (1 and 2 above), leading from A to B." -- --- We also identify each commodity's default valuation commodity, if --- any. For each commodity A, hledger picks a default valuation +-- and: "For each commodity A, hledger picks a default valuation -- commodity as follows, in this order of preference: -- -- 1. The price commodity from the latest declared market price for A @@ -318,35 +354,31 @@ tests_priceLookup = -- -- 3. If there are no P directives at all (any commodity or date), and -- the `--infer-value` flag is used, then the price commodity from --- the latest transaction price for A on or before valuation date. +-- the latest transaction price for A on or before valuation date." -- makePriceGraph :: [MarketPrice] -> [MarketPrice] -> Day -> PriceGraph makePriceGraph alldeclaredprices allinferredprices d = dbg9 ("makePriceGraph "++show d) $ - PriceGraph{prGraph=g, prNodemap=m, prDefaultValuationCommodities=defaultdests} + PriceGraph{ + pgDate = d + ,pgEdges=forwardprices + ,pgEdgesRev=allprices + ,pgDefaultValuationCommodities=defaultdests + } where -- prices in effect on date d, either declared or inferred visibledeclaredprices = dbg2 "visibledeclaredprices" $ filter ((<=d).mpdate) alldeclaredprices visibleinferredprices = dbg2 "visibleinferredprices" $ filter ((<=d).mpdate) allinferredprices - declaredandinferredprices = effectiveMarketPrices visibledeclaredprices visibleinferredprices + forwardprices = effectiveMarketPrices visibledeclaredprices visibleinferredprices -- infer any additional reverse prices not already declared or inferred reverseprices = dbg2 "additional reverse prices" $ - [p | p@MarketPrice{..} <- map marketPriceReverse declaredandinferredprices + [p | p@MarketPrice{..} <- map marketPriceReverse forwardprices , not $ (mpfrom,mpto) `S.member` forwardpairs ] where - forwardpairs = S.fromList [(mpfrom,mpto) | MarketPrice{..} <- declaredandinferredprices] - - -- build the graph and associated node map - (g, m) = - mkMapGraph - (dbg9 "price graph labels" $ sort allcomms) -- this must include all nodes mentioned in edges - (dbg9 "price graph edges" $ [(mpfrom, mpto, mprate) | MarketPrice{..} <- prices]) - :: (Gr CommoditySymbol Quantity, NodeMap CommoditySymbol) - where - prices = dbg2 "prices used as price graph edges" $ declaredandinferredprices ++ reverseprices - allcomms = map mpfrom prices + forwardpairs = S.fromList [(mpfrom,mpto) | MarketPrice{..} <- forwardprices] + allprices = forwardprices ++ reverseprices -- determine a default valuation commodity for each source commodity -- somewhat but not quite like effectiveMarketPrices @@ -389,31 +421,6 @@ marketPriceReverse :: MarketPrice -> MarketPrice marketPriceReverse mp@MarketPrice{..} = mp{mpfrom=mpto, mpto=mpfrom, mprate=if mprate==0 then 0 else 1/mprate} -- PARTIAL: / ------------------------------------------------------------------------------- --- fgl helpers - --- | Look up an existing graph node by its label. --- (If the node does not exist, a new one will be generated, but not --- persisted in the nodemap.) -node :: Ord a => NodeMap a -> a -> Node -node m = fst . fst . mkNode m - --- | Convert a valid path within the given graph to the corresponding --- edge labels. When there are multiple edges between two nodes, the --- lowest-sorting label is used. -pathEdgeLabels :: (Show b, Ord b) => Gr a b -> [Node] -> [b] -pathEdgeLabels g = map frommaybe . map (nodesEdgeLabel g) . pathEdges - where frommaybe = fromMaybe (error' "pathEdgeLabels: expected no Nothings here") -- PARTIAL: - --- | Convert a path to node pairs representing the path's edges. -pathEdges :: [Node] -> [(Node,Node)] -pathEdges p = [(f,t) | f:t:_ <- tails p] - --- | Get the label of a graph edge from one node to another. --- When there are multiple such edges, the lowest-sorting label is used. -nodesEdgeLabel :: Ord b => Gr a b -> (Node, Node) -> Maybe b -nodesEdgeLabel g (from,to) = headMay $ sort [l | (_,t,l) <- out g from, t==to] - nullmarketprice :: MarketPrice nullmarketprice = MarketPrice { mpdate=nulldate diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 639c00ea6..b1cdf1223 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 8be95614d73bb909eb29a27d8411f09623debad24f7fe84cf42ebc8b851a7ba8 +-- hash: db3635dfa2836ab24208180e8c88c2179321d6b634a359969844aa9974634577 name: hledger-lib version: 1.19.99 @@ -127,7 +127,6 @@ library , data-default >=0.5 , directory , extra >=1.6.3 - , fgl >=5.5.4.0 , file-embed >=0.0.10 , filepath , hashtables >=1.2.3.1 @@ -180,7 +179,6 @@ test-suite doctest , directory , doctest >=0.16.3 , extra >=1.6.3 - , fgl >=5.5.4.0 , file-embed >=0.0.10 , filepath , hashtables >=1.2.3.1 @@ -234,7 +232,6 @@ test-suite unittest , data-default >=0.5 , directory , extra >=1.6.3 - , fgl >=5.5.4.0 , file-embed >=0.0.10 , filepath , hashtables >=1.2.3.1 diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index e7602049a..47987db63 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -60,7 +60,6 @@ dependencies: - data-default >=0.5 - Decimal >=0.5.1 - directory -- fgl >=5.5.4.0 - file-embed >=0.0.10 - filepath - hashtables >=1.2.3.1 diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index bb4cb25ea..5aec6ba37 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -1196,23 +1196,27 @@ valued on the last day of the period, by default. To convert a commodity A to its market value in another commodity B, hledger looks for a suitable market price (exchange rate) as follows, in this order of preference - + : 1. A *declared market price* or *inferred market price*: A's latest market price in B on or before the valuation date - as declared by a [P directive](journal.html#declaring-market-prices), - or (if the `--infer-value` flag is used) + as declared by a [P directive](journal.html#declaring-market-prices), + or (with the `--infer-value` flag) inferred from [transaction prices](journal.html#transaction-prices). - + 2. A *reverse market price*: the inverse of a declared or inferred market price from B to A. -3. A *chained market price*: - a synthetic price formed by combining the shortest chain of market - prices (any of the above types) leading from A to B. +3. A *a forward chain of market prices*: + a synthetic price formed by combining the shortest chain of + "forward" (only 1 above) market prices, leading from A to B. + +4. A *any chain of market prices*: + a chain of any market prices, including both forward and + reverse prices (1 and 2 above), leading from A to B. Amounts for which no applicable market price can be found, are not converted. diff --git a/hledger/test/journal/valuation2.test b/hledger/test/journal/valuation2.test index 841ef1144..cd5aab787 100644 --- a/hledger/test/journal/valuation2.test +++ b/hledger/test/journal/valuation2.test @@ -291,13 +291,13 @@ $ hledger -f- bal -N -e 2020-11-20 -X A A 3.00 a # 29. #1402 It should pick the direct B->A price here, not the indirect B->C->A price. -# < -# 2020-11-10 -# (a) B 1.00 +< +2020-11-10 + (a) B 1.00 -# P 2020-11-01 B C 2 -# P 2020-11-02 C A 3 -# P 2020-11-03 B A 5 +P 2020-11-01 B C 2 +P 2020-11-02 C A 3 +P 2020-11-03 B A 5 -# $ hledger -f- bal -N -e 2020-11-20 -X A -# A 5 a +$ hledger -f- bal -N -e 2020-11-20 -X A + A 5 a