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
(n1, n2, REdgeF i ca (fa ! i) co)) $ labEdges g) :: Gr () REdgeF
showInstanceAsGraph :: PMInstance -> PMatching -> Gr String String
-showInstanceAsGraph (PMInstance numRvrs numProps rloadA prefA) (PMatching 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 ()
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 ()
-- 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)