program/TestUtils.hs

   1 module TestUtils where
   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
   7 import System.IO
   8 import System.Random
   9 import System.Posix.IO
  10 import System.Posix.Time
  11 import System.Process
  12 import Instance
  13 import ProposalMatcher
  14 import MonadStuff
  15
  16 -- This module has stuff that is helpful for testing but isn't itself an example.
  17
  18 -- A fixed-seeded random number generator for reproducible experimentation.
  19 myGen = read "314159265 1" :: StdGen
  20
  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)
  26 flowAnnotate g fa =
  27         mkGraph (labNodes g) (map (\(n1, n2, REdge i ca co) ->
  28                 (n1, n2, REdgeF i ca (fa ! i) co)) $ labEdges g) :: Gr () REdgeF
  29
  30 showInstanceAsGraph :: Instance -> [(Int, Int)] -> Gr String String
  31 showInstanceAsGraph (Instance numRvrs numProps rloadA prefA) matchedPairs =
  32         let
  33                 rvrNode i = i
  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 ++ ")"
  41                 theEdges = do
  42                         i <- [0..numRvrs-1]
  43                         j <- [0..numProps-1]
  44                         return (rvrNode i, propNode j,
  45                                 parenthesizeIf (elem (i, j) matchedPairs) $ show (prefA ! (i, j)))
  46         in mkGraph theNodes theEdges
  47
  48 goFile :: String -> IO ()
  49 goFile fname = do
  50         pid <- runCommand ("gnome-open " ++ fname)
  51         waitForProcess pid -- gnome-open exits immediately
  52         nop
  53
  54 createHandlePipe :: IO (Handle, Handle)
  55 createHandlePipe = do
  56         (rFd, wFd) <- createPipe
  57         rH <- fdToHandle rFd
  58         wH <- fdToHandle wFd
  59         return (rH, wH)
  60
  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 ()
  64 goGraph theGraph =
  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
  69         pt <- epochTime
  70         let fname = "graph-" ++ show pt ++ ".ps"
  71         dotPid <- runProcess "dot" ["-Tps", "-o", fname]
  72                 Nothing Nothing (Just rH) Nothing Nothing
  73         forkIO (do
  74                 hPutStr wH gvCode
  75                 hClose wH)
  76         waitForProcess dotPid
  77         -- Then open the file.
  78         goFile fname