mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 10:47:29 +03:00
lib: try to simplify, use just one price graph (#131)
This commit is contained in:
parent
dd5afbb6fe
commit
e664fab956
@ -15,8 +15,9 @@ module Hledger.Data.Prices (
|
||||
,amountApplyValuation
|
||||
,mixedAmountValueAtDate
|
||||
,mixedAmountApplyValuation
|
||||
,priceLookup
|
||||
,marketPriceReverse
|
||||
,priceDirectiveToMarketPrice
|
||||
,priceLookup
|
||||
,tests_Prices
|
||||
)
|
||||
where
|
||||
@ -24,7 +25,7 @@ where
|
||||
import Control.Applicative ((<|>))
|
||||
import Data.Decimal (roundTo)
|
||||
import Data.Function (on)
|
||||
import Data.Graph.Inductive (Gr, Node, NodeMap, mkMapGraph, mkNode, lab, out, suc, sp)
|
||||
import Data.Graph.Inductive (Gr, Node, NodeMap, mkMapGraph, mkNode, lab, out, sp)
|
||||
import Data.List
|
||||
import Data.List.Extra
|
||||
import qualified Data.Map as M
|
||||
@ -128,13 +129,12 @@ tests_priceLookup =
|
||||
-- into a single synthetic exchange rate ("indirect price").
|
||||
--
|
||||
-- When the valuation commodity is not specified, this looks for the
|
||||
-- latest applicable market price, and converts to the commodity
|
||||
-- mentioned in that price (default valuation commodity).
|
||||
-- latest applicable declared price, and converts to the commodity
|
||||
-- mentioned in that price (the default valuation commodity).
|
||||
--
|
||||
-- Note when calling this repeatedly for different periods, the
|
||||
-- default valuation commodity can vary, since it depends on the
|
||||
-- presence and parse order of market price declarations in each
|
||||
-- period.
|
||||
-- Note this default valuation commodity can vary across successive
|
||||
-- calls for different dates, since it depends on the price
|
||||
-- declarations in each period.
|
||||
--
|
||||
-- This returns the valuation commodity that was specified or
|
||||
-- inferred, and the quantity of it that one unit of the source
|
||||
@ -142,88 +142,81 @@ tests_priceLookup =
|
||||
-- prices can be found, or the source commodity and the valuation
|
||||
-- commodity are the same, returns Nothing.
|
||||
--
|
||||
-- A 'Prices' database (price graphs) is built each time this is
|
||||
-- called, which is probably wasteful when looking up multiple prices
|
||||
-- on the same day; it could be built at a higher level, or memoised.
|
||||
-- A 'PriceGraph' is built each time this is called, which is probably
|
||||
-- wasteful when looking up multiple prices on the same day; it could
|
||||
-- be built at a higher level, or memoised.
|
||||
--
|
||||
priceLookup :: [PriceDirective] -> Day -> CommoditySymbol -> Maybe CommoditySymbol -> Maybe (CommoditySymbol, Quantity)
|
||||
priceLookup pricedirectives d from mto =
|
||||
let
|
||||
-- build a graph of the commodity exchange rates in effect on this day
|
||||
-- XXX should hide these fgl details better
|
||||
Prices{prNodemap=m, prDeclaredPrices=g, prWithReversePrices=gr} = pricesAtDate pricedirectives d
|
||||
PriceGraph{prGraph=g, prNodemap=m, prDeclaredPairs=dps} = pricesAtDate pricedirectives d
|
||||
fromnode = node m from
|
||||
-- if to is unspecified, try to find a default valuation commodity based on available prices
|
||||
mto' = mto <|> mdefaultto
|
||||
where
|
||||
-- the default valuation commodity, if we could find one.
|
||||
-- If to is unspecified, try to pick a default valuation commodity from declared prices (only).
|
||||
-- XXX how to choose ? Take lowest sorted ?
|
||||
-- Take first, hoping current order is useful ? <-
|
||||
-- Keep parse order in label and take latest parsed ?
|
||||
mdefaultto = headMay (suc g fromnode) >>= lab g
|
||||
mdefaultto =
|
||||
dbg4 ("default valuation commodity for "++T.unpack from) $
|
||||
headMay [t | (f,t,_) <- out g fromnode, (f,t) `elem` dps] >>= lab g
|
||||
in
|
||||
case mto' of
|
||||
Nothing -> Nothing
|
||||
Just to | to==from -> Nothing
|
||||
Just to ->
|
||||
-- We have a commodity to convert to. Find the most direct price available.
|
||||
case
|
||||
-- These seem unnecessary, and we can avoid building one of the graphs
|
||||
-- mdeclaredprice <|> mreverseprice <|>
|
||||
mindirectprice of
|
||||
Nothing -> Nothing
|
||||
Just q -> Just (to, q)
|
||||
case mindirectprice of
|
||||
Nothing -> Nothing
|
||||
Just q -> Just (to, q)
|
||||
where
|
||||
tonode = node m to
|
||||
-- mdeclaredprice :: Maybe Quantity =
|
||||
-- dbg ("declared market price "++T.unpack from++"->"++T.unpack to) $
|
||||
-- nodesEdgeLabel g (fromnode,tonode)
|
||||
-- mreverseprice :: Maybe Quantity =
|
||||
-- dbg ("reverse market price "++T.unpack from++"->"++T.unpack to) $
|
||||
-- ((1 /) <$> nodesEdgeLabel g (tonode,fromnode))
|
||||
mindirectprice :: Maybe Quantity =
|
||||
-- Find the shortest path, if any, between from and to.
|
||||
-- This time use gr which includes both declared and reverse prices.
|
||||
case sp fromnode tonode gr :: Maybe [Node] of
|
||||
case sp fromnode tonode g :: Maybe [Node] of
|
||||
Nothing -> Nothing
|
||||
Just nodes ->
|
||||
dbg ("market price "++intercalate "->" (map T.unpack comms)) $
|
||||
Just $ product $ pathEdgeLabels gr nodes -- convert to a single exchange rate
|
||||
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 = dbg4With (((msg++": ")++) . maybe "" (show . roundTo 8))
|
||||
|
||||
-- | Convert a list of market price directives in parse order to
|
||||
-- a database of market prices in effect on a given day,
|
||||
-- allowing efficient lookup of exchange rates between commodity pairs.
|
||||
pricesAtDate :: [PriceDirective] -> Day -> Prices
|
||||
pricesAtDate pricedirectives d = Prices{
|
||||
prNodemap = m
|
||||
,prDeclaredPrices = g
|
||||
,prWithReversePrices = gr
|
||||
}
|
||||
-- | Convert a list of market price directives in parse order to a
|
||||
-- graph of all prices in effect on a given day, allowing efficient
|
||||
-- lookup of exchange rates between commodity pairs.
|
||||
pricesAtDate :: [PriceDirective] -> Day -> PriceGraph
|
||||
pricesAtDate pricedirectives d = PriceGraph{prGraph=g, prNodemap=m, prDeclaredPairs=dps}
|
||||
where
|
||||
-- get the latest (before d) declared price for each commodity pair
|
||||
latestdeclaredprices :: [MarketPrice] =
|
||||
dbg5 "latestdeclaredprices" $
|
||||
-- build the graph and associated node map
|
||||
(g :: Gr CommoditySymbol Quantity, m :: NodeMap CommoditySymbol) =
|
||||
mkMapGraph
|
||||
(dbg5 "g nodelabels" $ sort allcomms) -- this must include all nodes mentioned in edges
|
||||
(dbg5 "g edges" $ [(mpfrom, mpto, mprate) | MarketPrice{..} <- prices])
|
||||
where
|
||||
prices = declaredprices ++ reverseprices
|
||||
allcomms = map mpfrom prices
|
||||
|
||||
-- get the latest (on or before date d) declared price for each commodity pair
|
||||
declaredprices :: [MarketPrice] =
|
||||
dbg5 "declaredprices" $
|
||||
nubSortBy (compare `on` (\(MarketPrice{..})->(mpfrom,mpto))) $ -- keep only the first (ie newest and latest parsed) price for each pair
|
||||
map snd $ -- discard the parse order label
|
||||
sortBy (flip compare `on` (\(parseorder,mp)->(mpdate mp,parseorder))) $ -- sort with newest dates and latest parse order first
|
||||
zip [1..] $ -- label with parse order
|
||||
map priceDirectiveToMarketPrice $
|
||||
filter ((<=d).pddate) pricedirectives -- consider only price declarations up to the valuation date
|
||||
-- and the latest declared or reverse price for each commodity pair
|
||||
latestdeclaredandreverseprices =
|
||||
latestdeclaredprices `union` map marketPriceReverse latestdeclaredprices
|
||||
-- XXX hopefully this prioritises the declared prices, test
|
||||
allcomms = sort $ map mpfrom latestdeclaredandreverseprices
|
||||
(g :: PriceGraph, m :: NodeMap CommoditySymbol) = mkMapGraph
|
||||
(dbg5 "g nodelabels" allcomms) -- this must include all nodes mentioned in edges
|
||||
(dbg5 "g edges" [(mpfrom, mpto, mprate) | MarketPrice{..} <- latestdeclaredprices])
|
||||
(gr, _) = mkMapGraph
|
||||
(dbg5 "gr nodelabels" allcomms) -- this must include all nodes mentioned in edges
|
||||
(dbg5 "gr edges" [(mpfrom, mpto, mprate) | MarketPrice{..} <- latestdeclaredandreverseprices])
|
||||
|
||||
-- infer additional reverse prices where not already declared
|
||||
reverseprices =
|
||||
dbg5 "reverseprices" $
|
||||
map marketPriceReverse declaredprices \\ declaredprices
|
||||
|
||||
-- remember which edges correspond to declared prices
|
||||
dps = [(node m mpfrom, node m mpto) | MarketPrice{..} <- declaredprices ]
|
||||
|
||||
priceDirectiveToMarketPrice :: PriceDirective -> MarketPrice
|
||||
priceDirectiveToMarketPrice PriceDirective{..} =
|
||||
|
@ -27,7 +27,7 @@ import Data.Data
|
||||
import Data.Decimal
|
||||
import Data.Default
|
||||
import Data.Functor (($>))
|
||||
import Data.Graph.Inductive (Gr, NodeMap)
|
||||
import Data.Graph.Inductive (Gr,Node,NodeMap)
|
||||
import Data.List (intercalate)
|
||||
import Text.Blaze (ToMarkup(..))
|
||||
--XXX https://hackage.haskell.org/package/containers/docs/Data-Map.html
|
||||
@ -446,15 +446,23 @@ data MarketPrice = MarketPrice {
|
||||
|
||||
instance NFData MarketPrice
|
||||
|
||||
-- | A graph whose node labels are commodities and edge labels are exchange rates.
|
||||
type PriceGraph = Gr CommoditySymbol Quantity
|
||||
|
||||
-- | A snapshot of the known exchange rates between commodity pairs at a given date.
|
||||
data Prices = Prices {
|
||||
prNodemap :: NodeMap CommoditySymbol
|
||||
,prDeclaredPrices :: PriceGraph -- ^ Explicitly declared market prices for commodity pairs.
|
||||
,prWithReversePrices :: PriceGraph -- ^ The above, plus derived reverse prices for any pairs which don't have a declared price.
|
||||
-- ,prWithIndirectPrices :: PriceGraph -- ^ The above, plus indirect prices found for any pairs which don't have a declared or reverse price.
|
||||
-- | 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,
|
||||
-- either explicitly declared (preferred) or inferred by reversing a declared 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.
|
||||
,prDeclaredPairs :: [(Node,Node)]
|
||||
-- ^ Which of the edges in this graph are declared rates,
|
||||
-- rather than inferred reverse rates.
|
||||
-- A bit ugly. We could encode this in the edges,
|
||||
-- but those have to be Real for shortest path finding,
|
||||
-- so we'd have to transform them all first.
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user