2 import Control.Concurrent
3 import Data.Array.IArray
4 import Data.Graph.Inductive.Graph
5 import Data.Graph.Inductive.Graphviz
6 import Data.Graph.Inductive.Tree
10 import System.Posix.Time
13 import ProposalMatcher
16 -- This module has stuff that is helpful for testing but isn't itself an example.
18 -- A fixed-seeded random number generator for reproducible experimentation.
19 myGen = read "314159265 1" :: StdGen
21 -- Visualization stuff.
22 data REdgeF = REdgeF Int Int Int Wt
23 instance Show REdgeF where
24 show (REdgeF idx cap flow cost) = "#" ++ (show idx) ++ ": "
25 ++ (show flow) ++ " of " ++ (show cap) ++ " @ " ++ (show cost)
27 mkGraph (labNodes g) (map (\(n1, n2, REdge i ca co) ->
28 (n1, n2, REdgeF i ca (fa ! i) co)) $ labEdges g) :: Gr () REdgeF
30 showInstanceAsGraph :: PMInstance -> PMatching -> Gr String String
31 showInstanceAsGraph (PMInstance numRvrs numProps rloadA prefA) matchedPairs =
34 propNode j = numRvrs + j
35 numNodes = numRvrs + numProps
36 theNodes = map (\i -> (rvrNode i, "R#" ++ show i ++
37 " (RLoad " ++ show (rloadA ! i) ++ ")")) [0..numRvrs-1] ++
38 map (\j -> (propNode j, "P#" ++ show j)) [0..numProps-1]
39 parenthesizeIf False s = s
40 parenthesizeIf True s = "(" ++ s ++ ")"
44 return (rvrNode i, propNode j,
45 parenthesizeIf (elem (i, j) matchedPairs) $ show (prefA ! (i, j)))
46 in mkGraph theNodes theEdges
48 goFile :: String -> IO ()
50 pid <- runCommand ("gnome-open " ++ fname)
51 waitForProcess pid -- gnome-open exits immediately
54 createHandlePipe :: IO (Handle, Handle)
56 (rFd, wFd) <- createPipe
61 -- GHCi seems to crash if I call this on a "showInstanceAsGraph" result without
62 -- having previously forced evaluation of the matching.
63 goGraph :: (Show a, Show b, Graph gr) => gr a b -> IO ()
65 -- First generate graphviz code.
66 let gvCode = graphviz' theGraph in do
67 -- Then have `dot' convert it to postscript in a file.
68 (rH, wH) <- createHandlePipe
70 let fname = "graph-" ++ show pt ++ ".ps"
71 dotPid <- runProcess "dot" ["-Tps", "-o", fname]
72 Nothing Nothing (Just rH) Nothing Nothing
77 -- Then open the file.