lib: partial valuation fix, more debug output for #1402

hledger-lib/Hledger/Data/Valuation.hs

@@ -34,6 +34,7 @@ import Data.Graph.Inductive  (Gr, Node, NodeMap, mkMapGraph, mkNode, lab, out, s
 import Data.List
 import Data.List.Extra (nubSortBy)
 import qualified Data.Map as M
+import qualified Data.Set as S
 import Data.Maybe
 import qualified Data.Text as T
 import Data.Time.Calendar (Day, fromGregorian)
@@ -250,7 +251,7 @@ priceLookup makepricegraph d from mto =
           tonode = node m to
           mindirectprice :: Maybe Quantity =
             -- Find the shortest path, if any, between from and to.
-            case sp fromnode tonode g :: Maybe [Node] of
+            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)) $
@@ -325,14 +326,17 @@ makePriceGraph alldeclaredprices allinferredprices d =
   PriceGraph{prGraph=g, prNodemap=m, prDefaultValuationCommodities=defaultdests}
   where
     -- prices in effect on date d, either declared or inferred
-    visibledeclaredprices = filter ((<=d).mpdate) alldeclaredprices
+    visibledeclaredprices = dbg2 "visibledeclaredprices" $ filter ((<=d).mpdate) alldeclaredprices
-    visibleinferredprices = filter ((<=d).mpdate) allinferredprices
+    visibleinferredprices = dbg2 "visibleinferredprices" $ filter ((<=d).mpdate) allinferredprices
-    declaredandinferredprices = dbg2 "declaredandinferredprices" $
+    declaredandinferredprices = effectiveMarketPrices visibledeclaredprices visibleinferredprices
-      effectiveMarketPrices visibledeclaredprices visibleinferredprices
 
     -- infer any additional reverse prices not already declared or inferred
-    reverseprices = dbg2 "reverseprices" $
+    reverseprices = dbg2 "additional reverse prices" $
-      map marketPriceReverse declaredandinferredprices \\ declaredandinferredprices
+      [p | p@MarketPrice{..} <- map marketPriceReverse declaredandinferredprices
+         , not $ (mpfrom,mpto) `S.member` forwardpairs
+      ]
+      where
+        forwardpairs = S.fromList [(mpfrom,mpto) | MarketPrice{..} <- declaredandinferredprices]
 
     -- build the graph and associated node map
     (g, m) =
@@ -341,7 +345,7 @@ makePriceGraph alldeclaredprices allinferredprices d =
       (dbg9 "price graph edges" $ [(mpfrom, mpto, mprate) | MarketPrice{..} <- prices])
       :: (Gr CommoditySymbol Quantity, NodeMap CommoditySymbol)
       where
-        prices   = declaredandinferredprices ++ reverseprices
+        prices   = dbg2 "prices used as price graph edges" $ declaredandinferredprices ++ reverseprices
         allcomms = map mpfrom prices
 
     -- determine a default valuation commodity for each source commodity
@@ -371,6 +375,7 @@ effectiveMarketPrices declaredprices inferredprices =
     declaredprices' = [(1, i, p) | (i,p) <- zip [1..] declaredprices]
     inferredprices' = [(0, i, p) | (i,p) <- zip [1..] inferredprices]
   in
+    dbg2 "effective forward prices" $
     -- combine
     declaredprices' ++ inferredprices'
     -- sort by decreasing date then decreasing precedence then decreasing parse order

hledger/test/journal/valuation2.test

@@ -278,7 +278,19 @@ $ hledger -f- bal -N -V
 $ hledger -f- bal -N -V --infer-value
                   D3  a
 
-# 28. #1402 It should pick the A 5 price for B here.
+# 28. #1402 It should pick the direct (forward) A 3.00 price for B here,
+# not the reverse price.
+<
+2020-11-10 
+    (a)  B 1.00
+
+P 2020-11-01 B A 3.00
+P 2020-11-02 A B 0.40
+
+$ 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
@@ -287,6 +299,5 @@ $ hledger -f- bal -N -V --infer-value
 # P 2020-11-02 C A 3
 # P 2020-11-03 B A 5
 
-# $ hledger -f- bal -N -X A
+# $ hledger -f- bal -N -e 2020-11-20 -X A
 #                  A 5  a
-