code.grnet.gr Git - ganeti-local/blob - htest/Test/Ganeti/HTools/Graph.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3
   4 {-| Unittests for Ganeti.Htools.Graph
   5
   6 -}
   7
   8 {-
   9
  10 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
  11
  12 This program is free software; you can redistribute it and/or modify
  13 it under the terms of the GNU General Public License as published by
  14 the Free Software Foundation; either version 2 of the License, or
  15 (at your option) any later version.
  16
  17 This program is distributed in the hope that it will be useful, but
  18 WITHOUT ANY WARRANTY; without even the implied warranty of
  19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 General Public License for more details.
  21
  22 You should have received a copy of the GNU General Public License
  23 along with this program; if not, write to the Free Software
  24 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  25 02110-1301, USA.
  26
  27 -}
  28
  29 module Test.Ganeti.HTools.Graph (testHTools_Graph) where
  30
  31 import Test.QuickCheck
  32 import Test.HUnit
  33
  34 import Test.Ganeti.TestHelper
  35 import Test.Ganeti.TestCommon
  36
  37 import Ganeti.HTools.Graph
  38
  39 import qualified Data.Graph as Graph
  40 import qualified Data.IntMap as IntMap
  41
  42 {-# ANN module "HLint: ignore Use camelCase" #-}
  43
  44 data TestableGraph = TestableGraph Graph.Graph deriving (Show)
  45 data TestableClique = TestableClique Graph.Graph deriving (Show)
  46
  47 -- | Generate node bounds and edges for an undirected graph.
  48 -- A graph is undirected if for every (a, b) edge there is a
  49 -- corresponding (b, a) one.
  50 undirEdges :: Gen (Graph.Bounds, [Graph.Edge])
  51 undirEdges = sized undirEdges'
  52   where
  53     undirEdges' 0 = return ((0, 0), [])
  54     undirEdges' n = do
  55       maxv <- choose (1, n)
  56       edges <- listOf1 $ do
  57         i <- choose (0, maxv)
  58         j <- choose (0, maxv) `suchThat` (/= i)
  59         return [(i, j), (j, i)]
  60       return ((0, maxv), concat edges)
  61
  62 -- | Generate node bounds and edges for a clique.
  63 -- In a clique all nodes are directly connected to each other.
  64 cliqueEdges :: Gen (Graph.Bounds, [Graph.Edge])
  65 cliqueEdges = sized cliqueEdges'
  66   where
  67     cliqueEdges' 0 = return ((0, 0), [])
  68     cliqueEdges' n = do
  69       maxv <- choose (0, n)
  70       let edges = [(x, y) | x <- [0..maxv], y <- [0..maxv], x /= y]
  71       return ((0, maxv), edges)
  72
  73 instance Arbitrary TestableGraph where
  74   arbitrary = do
  75     (mybounds, myedges) <- undirEdges
  76     return . TestableGraph $ Graph.buildG mybounds myedges
  77
  78 instance Arbitrary TestableClique where
  79   arbitrary = do
  80     (mybounds, myedges) <- cliqueEdges
  81     return . TestableClique $ Graph.buildG mybounds myedges
  82
  83 -- | Check that the empty vertex color map is empty.
  84 case_emptyVertColorMapNull :: Assertion
  85 case_emptyVertColorMapNull = assertBool "" $ IntMap.null emptyVertColorMap
  86
  87 -- | Check that the empty vertex color map is zero in size.
  88 case_emptyVertColorMapEmpty :: Assertion
  89 case_emptyVertColorMapEmpty =
  90   assertEqual "" 0 $ IntMap.size emptyVertColorMap
  91
  92 -- | Check if each two consecutive elements on a list
  93 -- respect a given condition.
  94 anyTwo :: (a -> a -> Bool) -> [a] -> Bool
  95 anyTwo _ [] = True
  96 anyTwo _ [_] = True
  97 anyTwo op (x:y:xs) = (x `op` y) && anyTwo op (y:xs)
  98
  99 -- | Check order of vertices returned by verticesByDegreeAsc.
 100 prop_verticesByDegreeAscAsc :: TestableGraph -> Property
 101 prop_verticesByDegreeAscAsc (TestableGraph g) =
 102     anyTwo (<=) (degrees asc) ==? True
 103     where degrees = map (length . neighbors g)
 104           asc = verticesByDegreeAsc g
 105
 106 -- | Check order of vertices returned by verticesByDegreeDesc.
 107 prop_verticesByDegreeDescDesc :: TestableGraph -> Property
 108 prop_verticesByDegreeDescDesc (TestableGraph g) =
 109     anyTwo (>=) (degrees desc) ==? True
 110     where degrees = map (length . neighbors g)
 111           desc = verticesByDegreeDesc g
 112
 113 -- | Check that our generated graphs are colorable
 114 prop_isColorableTestableGraph :: TestableGraph -> Property
 115 prop_isColorableTestableGraph (TestableGraph g) = isColorable g ==? True
 116
 117 -- | Check that our generated graphs are colorable
 118 prop_isColorableTestableClique :: TestableClique -> Property
 119 prop_isColorableTestableClique (TestableClique g) = isColorable g ==? True
 120
 121 -- | Check that the given algorithm colors a clique with the same number of
 122 -- colors as the vertices number.
 123 prop_colorClique :: (Graph.Graph -> ColorVertMap) -> TestableClique -> Property
 124 prop_colorClique alg (TestableClique g) = numvertices ==? numcolors
 125     where numcolors = IntMap.size (alg g)
 126           numvertices = length (Graph.vertices g)
 127
 128 -- | Specific check for the LF algorithm.
 129 prop_colorLFClique :: TestableClique -> Property
 130 prop_colorLFClique = prop_colorClique colorLF
 131
 132 -- | Specific check for the Dsatur algorithm.
 133 prop_colorDsaturClique :: TestableClique -> Property
 134 prop_colorDsaturClique = prop_colorClique colorDsatur
 135
 136 -- Check that all nodes are colored.
 137 prop_colorAllNodes :: (Graph.Graph -> ColorVertMap)
 138                    -> TestableGraph
 139                    -> Property
 140 prop_colorAllNodes alg (TestableGraph g) = numvertices ==? numcolored
 141     where numcolored = IntMap.fold (\v l -> length v + l) 0 $ alg g
 142           numvertices = length (Graph.vertices g)
 143
 144 -- | Specific check for the LF algorithm.
 145 prop_colorLFAllNodes :: TestableGraph -> Property
 146 prop_colorLFAllNodes = prop_colorAllNodes colorLF
 147
 148 -- | Specific check for the Dsatur algorithm.
 149 prop_colorDsaturAllNodes :: TestableGraph -> Property
 150 prop_colorDsaturAllNodes = prop_colorAllNodes colorDsatur
 151
 152 -- | List of tests for the Graph module.
 153 testSuite "HTools/Graph"
 154             [ 'case_emptyVertColorMapNull
 155             , 'case_emptyVertColorMapEmpty
 156             , 'prop_verticesByDegreeAscAsc
 157             , 'prop_verticesByDegreeDescDesc
 158             , 'prop_colorLFClique
 159             , 'prop_colorDsaturClique
 160             , 'prop_colorLFAllNodes
 161             , 'prop_colorDsaturAllNodes
 162             , 'prop_isColorableTestableGraph
 163             , 'prop_isColorableTestableClique
 164             ]