## 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 |