Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / Graph.hs @ 7ec2f76b

History | View | Annotate | Download (7.7 kB)

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
DSatur is described in:
17
Brelaz, D. (1979), "New methods to color the vertices of a graph",
18
Communications of the ACM 22 (4): 251-256, doi:10.1145/359094.359101
19
<http://dx.doi.org/10.1145%2F359094.359101>
20

    
21
Also interesting:
22
Klotz, W. (2002). Graph coloring algorithms. Mathematics Report, Technical
23
University Clausthal, 1-9.
24
<http://www.math.tu-clausthal.de/Arbeitsgruppen/Diskrete-Optimierung
25
/publications/2002/gca.pdf>
26

    
27
-}
28

    
29
{-
30

    
31
Copyright (C) 2012, Google Inc.
32

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

    
38
This program is distributed in the hope that it will be useful, but
39
WITHOUT ANY WARRANTY; without even the implied warranty of
40
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
41
General Public License for more details.
42

    
43
You should have received a copy of the GNU General Public License
44
along with this program; if not, write to the Free Software
45
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
46
02110-1301, USA.
47

    
48
-}
49

    
50
module Ganeti.HTools.Graph
51
  ( -- * Types
52
    Color
53
  , VertColorMap
54
  , ColorVertMap
55
    -- * Creation
56
  , emptyVertColorMap
57
    -- * Coloring
58
  , colorInOrder
59
  , colorLF
60
  , colorDsatur
61
  , colorDcolor
62
  , isColorable
63
    -- * Color map transformations
64
  , colorVertMap
65
    -- * Vertex characteristics
66
  , verticesByDegreeDesc
67
  , verticesByDegreeAsc
68
  , neighbors
69
  , hasLoop
70
  , isUndirected
71
  ) where
72

    
73
import Data.Maybe
74
import Data.Ord
75
import Data.List
76

    
77
import qualified Data.IntMap as IntMap
78
import qualified Data.IntSet as IntSet
79
import qualified Data.Graph as Graph
80
import qualified Data.Array as Array
81

    
82
-- * Type declarations
83

    
84
-- | Node colors.
85
type Color = Int
86

    
87
-- | Saturation: number of colored neighbors.
88
type Satur = Int
89

    
90
-- | Vertex to Color association.
91
type VertColorMap = IntMap.IntMap Color
92

    
93
-- | Color to Vertex association.
94
type ColorVertMap = IntMap.IntMap [Int]
95

    
96
-- * Vertices characteristics
97

    
98
-- | (vertex, degree) tuples on a graph.
99
verticesDegree :: Graph.Graph -> [(Graph.Vertex, Int)]
100
verticesDegree g = Array.assocs $ Graph.outdegree g
101

    
102
-- | vertices of a graph, sorted by ascending degree.
103
verticesByDegreeDesc :: Graph.Graph -> [Graph.Vertex]
104
verticesByDegreeDesc g =
105
  map fst . sortBy (flip (comparing snd)) $ verticesDegree g
106

    
107
-- | vertices of a graph, sorted by descending degree.
108
verticesByDegreeAsc :: Graph.Graph -> [Graph.Vertex]
109
verticesByDegreeAsc g = map fst . sortBy (comparing snd) $ verticesDegree g
110

    
111
-- | Get the neighbors of a vertex.
112
neighbors :: Graph.Graph -> Graph.Vertex -> [Graph.Vertex]
113
neighbors g v = g Array.! v
114

    
115
-- | Check whether a graph has no loops.
116
-- (vertices connected to themselves)
117
hasLoop :: Graph.Graph -> Bool
118
hasLoop g = any vLoops $ Graph.vertices g
119
    where vLoops v = v `elem` neighbors g v
120

    
121
-- | Check whether a graph is undirected
122
isUndirected :: Graph.Graph -> Bool
123
isUndirected g =
124
  (sort . Graph.edges) g == (sort . Graph.edges . Graph.transposeG) g
125

    
126
-- * Coloring
127

    
128
-- | Empty color map.
129
emptyVertColorMap :: VertColorMap
130
emptyVertColorMap = IntMap.empty
131

    
132
-- | Check whether a graph is colorable.
133
isColorable :: Graph.Graph -> Bool
134
isColorable g = isUndirected g && not (hasLoop g)
135

    
136
-- | Get the colors of a list of vertices.
137
-- Any uncolored vertices are ignored.
138
verticesColors :: VertColorMap -> [Graph.Vertex] -> [Color]
139
verticesColors cMap = mapMaybe (`IntMap.lookup` cMap)
140

    
141
-- | Get the set of colors of a list of vertices.
142
-- Any uncolored vertices are ignored.
143
verticesColorSet :: VertColorMap -> [Graph.Vertex] -> IntSet.IntSet
144
verticesColorSet cMap = IntSet.fromList . verticesColors cMap
145

    
146
-- | Get the colors of the neighbors of a vertex.
147
neighColors :: Graph.Graph -> VertColorMap -> Graph.Vertex -> [Color]
148
neighColors g cMap v = verticesColors cMap $ neighbors g v
149

    
150
-- | Color one node.
151
colorNode :: Graph.Graph -> VertColorMap -> Graph.Vertex -> Color
152
-- use of "head" is A-ok as the source is an infinite list
153
colorNode g cMap v = head $ filter notNeighColor [0..]
154
    where notNeighColor = (`notElem` neighColors g cMap v)
155

    
156
-- | Color a node returning the updated color map.
157
colorNodeInMap :: Graph.Graph -> Graph.Vertex -> VertColorMap -> VertColorMap
158
colorNodeInMap g v cMap = IntMap.insert v newcolor cMap
159
    where newcolor = colorNode g cMap v
160

    
161
-- | Color greedily all nodes in the given order.
162
colorInOrder :: Graph.Graph -> [Graph.Vertex] -> VertColorMap
163
colorInOrder g = foldr (colorNodeInMap g) emptyVertColorMap
164

    
165
-- | Color greedily all nodes, larger first.
166
colorLF :: Graph.Graph -> VertColorMap
167
colorLF g = colorInOrder g $ verticesByDegreeAsc g
168

    
169
-- | (vertex, (saturation, degree)) for a vertex.
170
vertexSaturation :: Graph.Graph
171
                 -> VertColorMap
172
                 -> Graph.Vertex
173
                 -> (Graph.Vertex, (Satur, Int))
174
vertexSaturation g cMap v =
175
  (v, (IntSet.size (verticesColorSet cMap neigh), length neigh))
176
    where neigh = neighbors g v
177

    
178
-- | (vertex, (colordegree, degree)) for a vertex.
179
vertexColorDegree :: Graph.Graph
180
                  -> VertColorMap
181
                  -> Graph.Vertex
182
                  -> (Graph.Vertex, (Int, Int))
183
vertexColorDegree g cMap v =
184
  (v, (length (verticesColors cMap neigh), length neigh))
185
    where neigh = neighbors g v
186

    
187
-- | Color all nodes in a dynamic order.
188
-- We have a list of vertices still uncolored, and at each round we
189
-- choose&delete one vertex among the remaining ones. A helper function
190
-- is used to induce an order so that the next vertex can be chosen.
191
colorDynamicOrder :: Ord a
192
                  =>  (Graph.Graph
193
                      -> VertColorMap
194
                      -> Graph.Vertex
195
                      -> (Graph.Vertex, a)) -- ^ Helper to induce the choice
196
                  -> Graph.Graph -- ^ Target graph
197
                  -> VertColorMap -- ^ Accumulating vertex color map
198
                  -> [Graph.Vertex] -- ^ List of remaining vertices
199
                  -> VertColorMap -- ^ Output vertex color map
200
colorDynamicOrder _ _ cMap [] = cMap
201
colorDynamicOrder ordind g cMap l = colorDynamicOrder ordind g newmap newlist
202
    where newmap = colorNodeInMap g choosen cMap
203
          choosen = fst . maximumBy (comparing snd) $ ordlist
204
          ordlist = map (ordind g cMap) l
205
          newlist = delete choosen l
206

    
207
-- | Color greedily all nodes, highest number of colored neighbors, then
208
-- highest degree. This is slower than "colorLF" as we must dynamically
209
-- recalculate which node to color next among all remaining ones but
210
-- produces better results.
211
colorDcolor :: Graph.Graph -> VertColorMap
212
colorDcolor g =
213
  colorDynamicOrder vertexColorDegree g emptyVertColorMap $ Graph.vertices g
214

    
215
-- | Color greedily all nodes, highest saturation, then highest degree.
216
-- This is slower than "colorLF" as we must dynamically recalculate
217
-- which node to color next among all remaining ones but produces better
218
-- results.
219
colorDsatur :: Graph.Graph -> VertColorMap
220
colorDsatur g =
221
  colorDynamicOrder vertexSaturation g emptyVertColorMap $ Graph.vertices g
222

    
223
-- | ColorVertMap from VertColorMap.
224
colorVertMap :: VertColorMap -> ColorVertMap
225
colorVertMap = IntMap.foldWithKey
226
                 (flip (IntMap.insertWith ((:) . head)) . replicate 1)
227
                 IntMap.empty