- Implement CS2 min-cost-flow adaptor and generalize common min-cost-flow stuff

[match/match.git] / program / NaiveMinCostFlow.hs

diff --git a/program/NaiveMinCostFlow.hs b/program/NaiveMinCostFlow.hs
index 1347837..94ee20d 100644 (file)
--- a/program/NaiveMinCostFlow.hs
+++ b/program/NaiveMinCostFlow.hs
@@ -1,4 +1,5 @@
 module NaiveMinCostFlow (minCostFlow) where
+import IMinCostFlow
 import BellmanFord
 import MonadStuff
 import Data.Array.IArray
@@ -75,14 +76,8 @@ doFlow state = do
                        augment state augAmt augPath
                        doFlow state
 
-minCostFlow :: forall s gr a b i f c. (Graph gr, Ix i, Real f, Real c) =>
-       (i, i)       -> -- Range of edge indices
-       (b -> i)     -> -- Edge label -> unique edge index
-       (b -> f)     -> -- Edge label -> flow capacity
-       (b -> c)     -> -- Edge label -> cost per unit of flow
-       gr a b       -> -- Graph
-       (Node, Node) -> -- (source, sink)
-       Array i f       -- ! edge index -> flow value
+-- We need to put the type parameters in scope for the mkGraph call.
+minCostFlow :: forall gr a b i f c. (Graph gr, Ix i, Real f, Real c) => MinCostFlowImpl1 gr a b i f c
 minCostFlow idxBounds edgeIdx edgeCap edgeCost theGraph (source, sink) = runSTArray (do
                let ourFlipF isRev l =
                        MCFEdge (edgeIdx l) (edgeCap l)
@@ -93,7 +88,12 @@ minCostFlow idxBounds edgeIdx edgeCap edgeCost theGraph (source, sink) = runSTAr
                                (n1, n2, MCFEdge (edgeIdx l) (edgeCap l) (  edgeCost l ) False),
                                (n2, n1, MCFEdge (edgeIdx l)  undefined  (-(edgeCost l)) True )
                        ]) $ labEdges theGraph) :: gr a (MCFEdge i f c)
-               flow <- newArray idxBounds 0
+               -- Initialize only the slots of the flow array corresponding to
+               -- existing edges to zero to catch buggy callers that query
+               -- nonexistent edges.
+               flow <- newArray idxBounds undefined
+               sequence $ map (\(_, _, l) -> writeArray flow (edgeIdx l) 0)
+                       (labEdges theGraph)
                let state = MCFState graph2 source sink flow
                doFlow state
                return (mcfFlow state)