hgraph-1.10.0.0: benchmarks/PackingCycles.hs

{-# LANGUAGE BangPatterns #-}
module Main where

import HGraph.Directed.Generator
import HGraph.Directed.AdjacencyMap as AM
import qualified HGraph.Directed.Packing.Cycles as Packing
import Data.List
import System.Random
import Control.Monad
import Control.Monad.Trans.State
import System.Clock
    
runBench !(g,name) = do
  start <- getTime ProcessCPUTime
  let (packing, !k) = Packing.maximumI g
      !nVerts = numVertices g
      !nEdges = numArcs g
  end <- k `seq` getTime ProcessCPUTime
  let delta = (toNanoSecs $ diffTimeSpec end start) `div` 10^6 
  return $ ( intercalate ","
              [ show name
              , show nVerts
              , show nEdges
              , show delta
              , show k
              ] ,
            delta)

generateRandomInstances n = do
  gen <- newStdGen
  return $ (evalState 
    ( fmap concat $ replicateM n $ forM [4..15] $ \i -> do
        d <- randomDigraph (AM.emptyDigraph :: AM.Digraph Int) i (min ((i * (i - 1)) `div` 2) (6*i))
        numArcs d `seq` return (d, intercalate ";" [show $ numVertices d, show $ numArcs d])
    ) gen)

main = do
  randomInstances <- generateRandomInstances 10
  putStrLn "instance, vertices, edges, time (ms), solution"
  results <- mapM 
    (\i -> do
      result <- runBench i
      putStrLn $ fst result
      return result
    )
    randomInstances 
  let times = map snd results
  let totalTime = sum times
  return ()
  -- results <- mapM runBench randomInstances 
  -- let times = map snd results
  -- let totalTime = sum times
  -- putStrLn $ intercalate "\n" $ "instance, vertices, edges, time (ms), solution" : map fst results