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.IO
11 import System.Posix.Time
15 import ProposalMatcher
17 import PMInstanceGenerator
20 import RandomizedMonad
22 -- This module has stuff that is helpful for testing but isn't itself an example.
24 -- A fixed-seeded random number generator for reproducible experimentation.
25 myGen = read "314159265 1" :: StdGen
27 -- Visualization stuff.
28 data REdgeF = REdgeF Int Int Int Wt
29 instance Show REdgeF where
30 show (REdgeF idx cap flow cost) = "#" ++ (show idx) ++ ": "
31 ++ (show flow) ++ " of " ++ (show cap) ++ " @ " ++ (show cost)
33 mkGraph (labNodes g) (map (\(n1, n2, REdge i ca co) ->
34 (n1, n2, REdgeF i ca (fa ! i) co)) $ labEdges g) :: Gr () REdgeF
36 showInstanceAsGraph :: PMInstance -> PMatching -> Gr String String
37 showInstanceAsGraph (PMInstance numRvrs numProps rloadA prefA) matchedPairs =
40 propNode j = numRvrs + j
41 numNodes = numRvrs + numProps
42 theNodes = map (\i -> (rvrNode i, "R#" ++ show i ++
43 " (RLoad " ++ show (rloadA ! i) ++ ")")) [0..numRvrs-1] ++
44 map (\j -> (propNode j, "P#" ++ show j)) [0..numProps-1]
45 parenthesizeIf False s = s
46 parenthesizeIf True s = "(" ++ s ++ ")"
50 return (rvrNode i, propNode j,
51 parenthesizeIf (elem (i, j) matchedPairs) $ show (prefA ! (i, j)))
52 in mkGraph theNodes theEdges
54 goFile :: String -> IO ()
56 pid <- runCommand ("gnome-open " ++ fname)
57 waitForProcess pid -- gnome-open exits immediately
60 createHandlePipe :: IO (Handle, Handle)
62 (rFd, wFd) <- createPipe
67 -- GHCi seems to crash if I call this on a "showInstanceAsGraph" result without
68 -- having previously forced evaluation of the matching.
69 goGraph :: (Show a, Show b, Graph gr) => gr a b -> IO ()
71 -- First generate graphviz code.
72 let gvCode = graphviz' theGraph in do
73 -- Then have `dot' convert it to postscript in a file.
74 (rH, wH) <- createHandlePipe
76 let fname = "graph-" ++ show pt ++ ".ps"
77 dotPid <- runProcess "dot" ["-Tps", "-o", fname]
78 Nothing Nothing (Just rH) Nothing Nothing
83 -- Then open the file.
86 -- Both-ways list difference
87 (/\) :: Eq a => [a] -> [a] -> ([a], [a])
88 l1 /\ l2 = (l1 \\ l2, l2 \\ l1)
91 runEvaluation cfg nr np = do
92 let inst = runRandom myGen $ randomInstance cfg nr np
93 putStr (show inst ++ "\n")
94 let m0 = doMatching cfg{loadTolerance = 0} inst
95 putStr ("Matching with load tolerance 0:\n" ++ show m0 ++ "\n")
96 let m1 = doMatching cfg{loadTolerance = 1} inst
97 putStr ("Matching with load tolerance 1:\n" ++ show m1 ++ "\n")
98 putStr ("Differences:\n" ++ show (m0 /\ m1) ++ "\n")
99 let e0 = evaluateMatching cfg{loadTolerance = 0} inst m0
100 putStr ("Evaluation of first matching:\n" ++ show e0 ++ "\n")
101 let e1 = evaluateMatching cfg{loadTolerance = 1} inst m1
102 putStr ("Evaluation of second matching:\n" ++ show e1 ++ "\n")
103 putStr ("Evaluation differences:\n" ++
104 show (sortedDiffEvaluations e0 e1) ++ "\n")