module TestUtils where import Control.Concurrent import Data.Array.IArray import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Graphviz import Data.Graph.Inductive.Tree import System.IO import System.Random import System.Posix.IO import System.Posix.Time import System.Process import Instance import ProposalMatcher import MonadStuff -- This module has stuff that is helpful for testing but isn't itself an example. -- A fixed-seeded random number generator for reproducible experimentation. myGen = read "314159265 1" :: StdGen -- Visualization stuff. data REdgeF = REdgeF Int Int Int Wt instance Show REdgeF where show (REdgeF idx cap flow cost) = "#" ++ (show idx) ++ ": " ++ (show flow) ++ " of " ++ (show cap) ++ " @ " ++ (show cost) flowAnnotate g fa = mkGraph (labNodes g) (map (\(n1, n2, REdge i ca co) -> (n1, n2, REdgeF i ca (fa ! i) co)) $ labEdges g) :: Gr () REdgeF showInstanceAsGraph :: Instance -> [(Int, Int)] -> Gr String String showInstanceAsGraph (Instance numRvrs numProps rloadA prefA) 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] 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))) in mkGraph theNodes theEdges goFile :: String -> IO () goFile fname = do pid <- runCommand ("gnome-open " ++ fname) waitForProcess pid -- gnome-open exits immediately nop createHandlePipe :: IO (Handle, Handle) createHandlePipe = do (rFd, wFd) <- createPipe rH <- fdToHandle rFd wH <- fdToHandle wFd return (rH, wH) -- 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 () 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) waitForProcess dotPid -- Then open the file. goFile fname