Quick hacks to try to get this working again in 2021.

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

diff --git a/program/TestUtils.hs b/program/TestUtils.hs
index 623391d..e842587 100644 (file)
--- a/program/TestUtils.hs
+++ b/program/TestUtils.hs
@@ -2,15 +2,19 @@ module TestUtils where
 import Control.Concurrent
 import Data.Array.IArray
 import Data.Graph.Inductive.Graph
-import Data.Graph.Inductive.Graphviz
+-- I couldn't find this module any more. ~ 2021-08-12
+--import Data.Graph.Inductive.Graphviz
 import Data.Graph.Inductive.Tree
 import Data.List
 import System.IO
 import System.Random
 import System.Posix.IO
 import System.Posix.Time
-import System.Process
+-- createPipe creates an ambiguity with System.Posix.IO.createPipe. I think
+-- either should work, so hide this one.
+import System.Process hiding (createPipe)
 import PMInstance
+import PMConfig
 import ProposalMatcher
 import PMDefaults
 import PMInstanceGenerator
@@ -33,21 +37,22 @@ flowAnnotate g fa =
                (n1, n2, REdgeF i ca (fa ! i) co)) $ labEdges g) :: Gr () REdgeF
 
 showInstanceAsGraph :: PMInstance -> PMatching -> Gr String String
-showInstanceAsGraph (PMInstance numRvrs numProps rloadA prefA) matchedPairs =
+showInstanceAsGraph (PMInstance numRvrs numProps rloadA prefA expA fixA pnrA) (PMatching matchedPairs) =
        let
                rvrNode i = i
                propNode j = numRvrs + j
                numNodes = numRvrs + numProps
                theNodes = map (\i -> (rvrNode i, "R#" ++ show i ++
                                " (RLoad " ++ show (rloadA ! i) ++ ")")) [0..numRvrs-1] ++
-                       map (\j -> (propNode j, "P#" ++ show j)) [0..numProps-1]
+                       map (\j -> (propNode j, "P#" ++ show j ++ "[" ++ show (pnrA ! j) ++ "]")) [0..numProps-1]
                parenthesizeIf False s = s
                parenthesizeIf True s = "(" ++ s ++ ")"
                theEdges = do
                        i <- [0..numRvrs-1]
                        j <- [0..numProps-1]
                        return (rvrNode i, propNode j,
-                               parenthesizeIf (elem (i, j) matchedPairs) $ show (prefA ! (i, j)))
+                               parenthesizeIf (elem (i, j) matchedPairs) $
+                               show (prefA ! (i, j)) ++ ":" ++ show (expA ! (i, j)) ++ (if fixA ! (i, j) then "*" else ""))
        in mkGraph theNodes theEdges
 
 goFile :: String -> IO ()
@@ -63,6 +68,9 @@ createHandlePipe = do
        wH <- fdToHandle wFd
        return (rH, wH)
 
+{- Comment this out because it depends on Data.Graph.Inductive.Graphviz, which I
+   don't have access to at the moment.
+
 -- GHCi seems to crash if I call this on a "showInstanceAsGraph" result without
 -- having previously forced evaluation of the matching.
 goGraph :: (Show a, Show b, Graph gr) => gr a b -> IO ()
@@ -70,34 +78,33 @@ goGraph theGraph =
        -- First generate graphviz code.
        let gvCode = graphviz' theGraph in do
        -- Then have `dot' convert it to postscript in a file.
-       (rH, wH) <- createHandlePipe
        pt <- epochTime
        let fname = "graph-" ++ show pt ++ ".ps"
-       dotPid <- runProcess "dot" ["-Tps", "-o", fname]
-               Nothing Nothing (Just rH) Nothing Nothing
-       forkIO (do
-               hPutStr wH gvCode
-               hClose wH)
+       (Just wH, _, _, dotPid) <- createProcess (proc "dot" ["-Tps", "-o", fname]) {std_in = CreatePipe}
+       hPutStr wH gvCode
+       hClose wH
        waitForProcess dotPid
        -- Then open the file.
        goFile fname
 
+-}
+
 -- Both-ways list difference
 (/\) :: Eq a => [a] -> [a] -> ([a], [a])
 l1 /\ l2 = (l1 \\ l2, l2 \\ l1)
 
 -- Evaluation!
-runEvaluation nr np = do
-       let inst = runRandom myGen $ randomInstance nr np
+runEvaluation cfg nr np = do
+       let inst = runRandom myGen $ randomInstance cfg nr np
        putStr (show inst ++ "\n")
-       let m0 = doMatching pmDefaults{loadTolerance = 0} inst
+       let PMatching m0 = doMatching cfg{loadTolerance = 0} inst
        putStr ("Matching with load tolerance 0:\n" ++ show m0 ++ "\n")
-       let m1 = doMatching pmDefaults{loadTolerance = 1} inst
+       let PMatching m1 = doMatching cfg{loadTolerance = 1} inst
        putStr ("Matching with load tolerance 1:\n" ++ show m1 ++ "\n")
        putStr ("Differences:\n" ++ show (m0 /\ m1) ++ "\n")
-       let e0 = evaluateMatching pmDefaults{loadTolerance = 0} inst m0
+       let e0 = evaluateMatching cfg{loadTolerance = 0} inst (PMatching m0)
        putStr ("Evaluation of first matching:\n" ++ show e0 ++ "\n")
-       let e1 = evaluateMatching pmDefaults{loadTolerance = 1} inst m1
+       let e1 = evaluateMatching cfg{loadTolerance = 1} inst (PMatching m1)
        putStr ("Evaluation of second matching:\n" ++ show e1 ++ "\n")
        putStr ("Evaluation differences:\n" ++
                show (sortedDiffEvaluations e0 e1) ++ "\n")