Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / Graph.hs @ 241cea1e

History | View | Annotate | Download (7.8 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, 2013, 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
{-# ANN colorNode "HLint: ignore Use alternative" #-}
151
-- | Color one node.
152
colorNode :: Graph.Graph -> VertColorMap -> Graph.Vertex -> Color
153
-- use of "head" is A-ok as the source is an infinite list
154
colorNode g cMap v = head $ filter notNeighColor [0..]
155
    where notNeighColor = (`notElem` neighColors g cMap v)
156

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

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

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

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

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

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

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

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

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