Revision 8e6623c8

b/Makefile.am
460 460
	htools/Ganeti/HTools/Cluster.hs \
461 461
	htools/Ganeti/HTools/Container.hs \
462 462
	htools/Ganeti/HTools/ExtLoader.hs \
463
	htools/Ganeti/HTools/Graph.hs \
463 464
	htools/Ganeti/HTools/Group.hs \
464 465
	htools/Ganeti/HTools/Instance.hs \
465 466
	htools/Ganeti/HTools/Loader.hs \
......
511 512
	htest/Test/Ganeti/HTools/CLI.hs \
512 513
	htest/Test/Ganeti/HTools/Cluster.hs \
513 514
	htest/Test/Ganeti/HTools/Container.hs \
515
	htest/Test/Ganeti/HTools/Graph.hs \
514 516
	htest/Test/Ganeti/HTools/Instance.hs \
515 517
	htest/Test/Ganeti/HTools/Loader.hs \
516 518
	htest/Test/Ganeti/HTools/Node.hs \
b/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 that the given algorithm colors a clique with the same number of
93
-- colors as the vertices number.
94
prop_colorClique :: (Graph.Graph -> ColorVertMap) -> TestableClique -> Property
95
prop_colorClique alg (TestableClique g) = numvertices ==? numcolors
96
    where numcolors = IntMap.size (alg g)
97
          numvertices = length (Graph.vertices g)
98

  
99
-- | Specific check for the LF algorithm.
100
prop_colorLFClique :: TestableClique -> Property
101
prop_colorLFClique = prop_colorClique colorLF
102

  
103
-- Check that all nodes are colored.
104
prop_colorAllNodes :: (Graph.Graph -> ColorVertMap)
105
                   -> TestableGraph
106
                   -> Property
107
prop_colorAllNodes alg (TestableGraph g) = numvertices ==? numcolored
108
    where numcolored = IntMap.fold (\v l -> length v + l) 0 $ alg g
109
          numvertices = length (Graph.vertices g)
110

  
111
-- | Specific check for the LF algorithm.
112
prop_colorLFAllNodes :: TestableGraph -> Property
113
prop_colorLFAllNodes = prop_colorAllNodes colorLF
114

  
115
-- | List of tests for the Graph module.
116
testSuite "HTools/Graph"
117
            [ 'case_emptyVertColorMapNull
118
            , 'case_emptyVertColorMapEmpty
119
            , 'prop_colorLFClique
120
            , 'prop_colorLFAllNodes
121
            ]
b/htest/test.hs
43 43
import Test.Ganeti.HTools.CLI
44 44
import Test.Ganeti.HTools.Cluster
45 45
import Test.Ganeti.HTools.Container
46
import Test.Ganeti.HTools.Graph
46 47
import Test.Ganeti.HTools.Instance
47 48
import Test.Ganeti.HTools.Loader
48 49
import Test.Ganeti.HTools.Node
......
90 91
  , testHTools_CLI
91 92
  , testHTools_Cluster
92 93
  , testHTools_Container
94
  , testHTools_Graph
93 95
  , testHTools_Instance
94 96
  , testHTools_Loader
95 97
  , testHTools_Node
b/htools/Ganeti/HTools/Graph.hs
1
{-| Algorithms on Graphs.
2

  
3
This module contains a few graph algorithms and the transoformations
4
needed for them to be used on nodes.
5

  
6
For more information about Graph Coloring see:
7
<http://en.wikipedia.org/wiki/Graph_coloring>
8
<http://en.wikipedia.org/wiki/Greedy_coloring>
9

  
10
LF-coloring is described in:
11
Welsh, D. J. A.; Powell, M. B. (1967), "An upper bound for the chromatic number
12
of a graph and its application to timetabling problems", The Computer Journal
13
10 (1): 85-86, doi:10.1093/comjnl/10.1.85
14
<http://comjnl.oxfordjournals.org/content/10/1/85>
15

  
16
-}
17

  
18
{-
19

  
20
Copyright (C) 2012, Google Inc.
21

  
22
This program is free software; you can redistribute it and/or modify
23
it under the terms of the GNU General Public License as published by
24
the Free Software Foundation; either version 2 of the License, or
25
(at your option) any later version.
26

  
27
This program is distributed in the hope that it will be useful, but
28
WITHOUT ANY WARRANTY; without even the implied warranty of
29
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
30
General Public License for more details.
31

  
32
You should have received a copy of the GNU General Public License
33
along with this program; if not, write to the Free Software
34
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
35
02110-1301, USA.
36

  
37
-}
38

  
39
module Ganeti.HTools.Graph
40
  ( -- * Types
41
    Color
42
  , VertColorMap
43
  , ColorVertMap
44
    -- * Creation
45
  , emptyVertColorMap
46
    -- * Coloring
47
  , colorInOrder
48
  , colorLF
49
    -- * Color map transformations
50
  , colorVertMap
51
    -- * Vertex sorting
52
  , verticesByDegreeDesc
53
  , verticesByDegreeAsc
54
  ) where
55

  
56
import Data.Maybe
57
import Data.Ord
58
import Data.List
59

  
60
import qualified Data.IntMap as IntMap
61
import qualified Data.Graph as Graph
62
import qualified Data.Array as Array
63

  
64
-- * Type declarations
65

  
66
-- | Node colors.
67
type Color = Int
68

  
69
-- | Vertex to Color association.
70
type VertColorMap = IntMap.IntMap Color
71

  
72
-- | Color to Vertex association.
73
type ColorVertMap = IntMap.IntMap [Int]
74

  
75
-- * Sorting of vertices
76

  
77
-- | (vertex, degree) tuples on a graph.
78
verticesDegree :: Graph.Graph -> [(Graph.Vertex, Int)]
79
verticesDegree g = Array.assocs $ Graph.outdegree g
80

  
81
-- | vertices of a graph, sorted by ascending degree.
82
verticesByDegreeDesc :: Graph.Graph -> [Graph.Vertex]
83
verticesByDegreeDesc g =
84
  map fst . sortBy (flip (comparing snd)) $ verticesDegree g
85

  
86
-- | vertices of a graph, sorted by descending degree.
87
verticesByDegreeAsc :: Graph.Graph -> [Graph.Vertex]
88
verticesByDegreeAsc g = map fst . sortBy (comparing snd) $ verticesDegree g
89

  
90
-- * Coloring
91

  
92
-- | Empty color map.
93
emptyVertColorMap :: VertColorMap
94
emptyVertColorMap = IntMap.empty
95

  
96
-- | Get the colors of the neighbors of a vertex.
97
neighColors :: Graph.Graph -> VertColorMap -> Graph.Vertex -> [Color]
98
neighColors g cMap v = mapMaybe (`IntMap.lookup` cMap) neighbors
99
    where neighbors = g Array.! v
100

  
101
-- | Color one node.
102
colorNode :: Graph.Graph -> VertColorMap -> Graph.Vertex -> Color
103
-- use of "head" is A-ok as the source is an infinite list
104
colorNode g cMap v = head $ filter notNeighColor [0..]
105
    where notNeighColor = (`notElem` neighColors g cMap v)
106

  
107
-- | Color a node returning the updated color map.
108
colorNodeInMap :: Graph.Graph -> Graph.Vertex -> VertColorMap -> VertColorMap
109
colorNodeInMap g v cMap = IntMap.insert v newcolor cMap
110
    where newcolor = colorNode g cMap v
111

  
112
-- | Color greedily all nodes in the given order.
113
colorInOrder :: Graph.Graph -> [Graph.Vertex] -> VertColorMap
114
colorInOrder g = foldr (colorNodeInMap g) emptyVertColorMap
115

  
116
-- | Color greedily all nodes, larger first.
117
colorLF :: Graph.Graph -> ColorVertMap
118
colorLF g = colorVertMap . colorInOrder g $ verticesByDegreeAsc g
119

  
120
-- | ColorVertMap from VertColorMap.
121
colorVertMap :: VertColorMap -> ColorVertMap
122
colorVertMap = IntMap.foldWithKey
123
                 (flip (IntMap.insertWith ((:) . head)) . replicate 1)
124
                 IntMap.empty

Also available in: Unified diff