set-cover-0.1.2: example/GraphColoring.hs

module Main where

import qualified GraphColoring.CutEnumSet as CutEnumSet
import qualified GraphColoring.CutSet as CutSet
import GraphColoring.Solve

import qualified Math.SetCover.Exact as ESC

import qualified Data.Set as Set
import Text.Printf (printf)

import System.TimeIt (timeIt)


mainCount :: IO ()
mainCount = do
   let example = (['a'..'g'], complete 7)
   printf "plain: %d\n" $
      length $ ESC.search $
      ESC.compressState Set.toList $ initialize assigns example
   printf "cut branch by set: %d\n" $
      length $ CutSet.search $ CutSet.initState $
      ESC.intSetFromSetAssigns $ uncurry assigns example
   printf "cut branch by enumset: %d\n" $
      length $ CutEnumSet.search $ CutEnumSet.initState $
      ESC.intSetFromSetAssigns $ uncurry assignsEdgeColor example

   printf "cut branch by enumset big: %d\n" $
      length $ CutEnumSet.search $ CutEnumSet.initState $
      ESC.intSetFromSetAssigns $
         uncurry assignsEdgeColor (['a'..'z'], complete 30)

mainSolution :: IO ()
mainSolution =
   CutEnumSet.run $ ESC.intSetFromSetAssigns $
   uncurry assignsEdgeColor example5


{-
The algorithm that cuts away branches
was intended to be more efficient,
but actually needs much more time:

plain:
coloring impossible
CPU time:   8.95s

cut branch:
coloring impossible
CPU time:  61.92s


Reason:
The improved algorithm actually did not cut away cases,
it only fixes the first color,
and thus is factor n slower than the algorithm that fixes the first two colors.
-}
mainImpossible :: IO ()
mainImpossible = do
   let example = (['a'..'h'], complete 10)
   putStrLn "\nplain:"
   timeIt $ run $ ESC.compressState Set.toList $ initialize assigns example
   putStrLn "\nreserve edge:"
   timeIt $ run $ ESC.compressState Set.toList $
      initialize assignsReserveEdge example
   putStrLn "\ncut branch by set:"
   timeIt $ CutSet.run $ ESC.intSetFromSetAssigns $ uncurry assigns example
   putStrLn "\ncut branch by enumset:"
   timeIt $ CutEnumSet.run $ ESC.intSetFromSetAssigns $
      uncurry assignsEdgeColor example


main :: IO ()
main = mainSolution