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

History | View | Annotate | Download (7.8 kB)

1 | 8e6623c8 | Guido Trotter | {-| Algorithms on Graphs. |
---|---|---|---|

2 | 8e6623c8 | Guido Trotter | |

3 | 8e6623c8 | Guido Trotter | This module contains a few graph algorithms and the transoformations |

4 | 8e6623c8 | Guido Trotter | needed for them to be used on nodes. |

5 | 8e6623c8 | Guido Trotter | |

6 | 8e6623c8 | Guido Trotter | For more information about Graph Coloring see: |

7 | 8e6623c8 | Guido Trotter | <http://en.wikipedia.org/wiki/Graph_coloring> |

8 | 8e6623c8 | Guido Trotter | <http://en.wikipedia.org/wiki/Greedy_coloring> |

9 | 8e6623c8 | Guido Trotter | |

10 | 8e6623c8 | Guido Trotter | LF-coloring is described in: |

11 | 8e6623c8 | Guido Trotter | Welsh, D. J. A.; Powell, M. B. (1967), "An upper bound for the chromatic number |

12 | 8e6623c8 | Guido Trotter | of a graph and its application to timetabling problems", The Computer Journal |

13 | 8e6623c8 | Guido Trotter | 10 (1): 85-86, doi:10.1093/comjnl/10.1.85 |

14 | 8e6623c8 | Guido Trotter | <http://comjnl.oxfordjournals.org/content/10/1/85> |

15 | 8e6623c8 | Guido Trotter | |

16 | 742bd043 | Guido Trotter | DSatur is described in: |

17 | 742bd043 | Guido Trotter | Brelaz, D. (1979), "New methods to color the vertices of a graph", |

18 | 742bd043 | Guido Trotter | Communications of the ACM 22 (4): 251-256, doi:10.1145/359094.359101 |

19 | 742bd043 | Guido Trotter | <http://dx.doi.org/10.1145%2F359094.359101> |

20 | 742bd043 | Guido Trotter | |

21 | 742bd043 | Guido Trotter | Also interesting: |

22 | 742bd043 | Guido Trotter | Klotz, W. (2002). Graph coloring algorithms. Mathematics Report, Technical |

23 | 742bd043 | Guido Trotter | University Clausthal, 1-9. |

24 | 742bd043 | Guido Trotter | <http://www.math.tu-clausthal.de/Arbeitsgruppen/Diskrete-Optimierung |

25 | 742bd043 | Guido Trotter | /publications/2002/gca.pdf> |

26 | 742bd043 | Guido Trotter | |

27 | 8e6623c8 | Guido Trotter | -} |

28 | 8e6623c8 | Guido Trotter | |

29 | 8e6623c8 | Guido Trotter | {- |

30 | 8e6623c8 | Guido Trotter | |

31 | 72747d91 | Iustin Pop | Copyright (C) 2012, 2013, Google Inc. |

32 | 8e6623c8 | Guido Trotter | |

33 | 8e6623c8 | Guido Trotter | This program is free software; you can redistribute it and/or modify |

34 | 8e6623c8 | Guido Trotter | it under the terms of the GNU General Public License as published by |

35 | 8e6623c8 | Guido Trotter | the Free Software Foundation; either version 2 of the License, or |

36 | 8e6623c8 | Guido Trotter | (at your option) any later version. |

37 | 8e6623c8 | Guido Trotter | |

38 | 8e6623c8 | Guido Trotter | This program is distributed in the hope that it will be useful, but |

39 | 8e6623c8 | Guido Trotter | WITHOUT ANY WARRANTY; without even the implied warranty of |

40 | 8e6623c8 | Guido Trotter | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |

41 | 8e6623c8 | Guido Trotter | General Public License for more details. |

42 | 8e6623c8 | Guido Trotter | |

43 | 8e6623c8 | Guido Trotter | You should have received a copy of the GNU General Public License |

44 | 8e6623c8 | Guido Trotter | along with this program; if not, write to the Free Software |

45 | 8e6623c8 | Guido Trotter | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |

46 | 8e6623c8 | Guido Trotter | 02110-1301, USA. |

47 | 8e6623c8 | Guido Trotter | |

48 | 8e6623c8 | Guido Trotter | -} |

49 | 8e6623c8 | Guido Trotter | |

50 | 8e6623c8 | Guido Trotter | module Ganeti.HTools.Graph |

51 | 8e6623c8 | Guido Trotter | ( -- * Types |

52 | 8e6623c8 | Guido Trotter | Color |

53 | 8e6623c8 | Guido Trotter | , VertColorMap |

54 | 8e6623c8 | Guido Trotter | , ColorVertMap |

55 | 8e6623c8 | Guido Trotter | -- * Creation |

56 | 8e6623c8 | Guido Trotter | , emptyVertColorMap |

57 | 8e6623c8 | Guido Trotter | -- * Coloring |

58 | 8e6623c8 | Guido Trotter | , colorInOrder |

59 | 8e6623c8 | Guido Trotter | , colorLF |

60 | 742bd043 | Guido Trotter | , colorDsatur |

61 | 8b50de5c | Guido Trotter | , colorDcolor |

62 | faef859e | Guido Trotter | , isColorable |

63 | 8e6623c8 | Guido Trotter | -- * Color map transformations |

64 | 8e6623c8 | Guido Trotter | , colorVertMap |

65 | faef859e | Guido Trotter | -- * Vertex characteristics |

66 | 8e6623c8 | Guido Trotter | , verticesByDegreeDesc |

67 | 8e6623c8 | Guido Trotter | , verticesByDegreeAsc |

68 | faef859e | Guido Trotter | , neighbors |

69 | faef859e | Guido Trotter | , hasLoop |

70 | faef859e | Guido Trotter | , isUndirected |

71 | 8e6623c8 | Guido Trotter | ) where |

72 | 8e6623c8 | Guido Trotter | |

73 | 8e6623c8 | Guido Trotter | import Data.Maybe |

74 | 8e6623c8 | Guido Trotter | import Data.Ord |

75 | 8e6623c8 | Guido Trotter | import Data.List |

76 | 8e6623c8 | Guido Trotter | |

77 | 8e6623c8 | Guido Trotter | import qualified Data.IntMap as IntMap |

78 | 8b50de5c | Guido Trotter | import qualified Data.IntSet as IntSet |

79 | 8e6623c8 | Guido Trotter | import qualified Data.Graph as Graph |

80 | 8e6623c8 | Guido Trotter | import qualified Data.Array as Array |

81 | 8e6623c8 | Guido Trotter | |

82 | 8e6623c8 | Guido Trotter | -- * Type declarations |

83 | 8e6623c8 | Guido Trotter | |

84 | 8e6623c8 | Guido Trotter | -- | Node colors. |

85 | 8e6623c8 | Guido Trotter | type Color = Int |

86 | 8e6623c8 | Guido Trotter | |

87 | 742bd043 | Guido Trotter | -- | Saturation: number of colored neighbors. |

88 | 742bd043 | Guido Trotter | type Satur = Int |

89 | 742bd043 | Guido Trotter | |

90 | 8e6623c8 | Guido Trotter | -- | Vertex to Color association. |

91 | 8e6623c8 | Guido Trotter | type VertColorMap = IntMap.IntMap Color |

92 | 8e6623c8 | Guido Trotter | |

93 | 8e6623c8 | Guido Trotter | -- | Color to Vertex association. |

94 | 8e6623c8 | Guido Trotter | type ColorVertMap = IntMap.IntMap [Int] |

95 | 8e6623c8 | Guido Trotter | |

96 | 742bd043 | Guido Trotter | -- * Vertices characteristics |

97 | 8e6623c8 | Guido Trotter | |

98 | 8e6623c8 | Guido Trotter | -- | (vertex, degree) tuples on a graph. |

99 | 8e6623c8 | Guido Trotter | verticesDegree :: Graph.Graph -> [(Graph.Vertex, Int)] |

100 | 8e6623c8 | Guido Trotter | verticesDegree g = Array.assocs $ Graph.outdegree g |

101 | 8e6623c8 | Guido Trotter | |

102 | 8e6623c8 | Guido Trotter | -- | vertices of a graph, sorted by ascending degree. |

103 | 8e6623c8 | Guido Trotter | verticesByDegreeDesc :: Graph.Graph -> [Graph.Vertex] |

104 | 8e6623c8 | Guido Trotter | verticesByDegreeDesc g = |

105 | 8e6623c8 | Guido Trotter | map fst . sortBy (flip (comparing snd)) $ verticesDegree g |

106 | 8e6623c8 | Guido Trotter | |

107 | 8e6623c8 | Guido Trotter | -- | vertices of a graph, sorted by descending degree. |

108 | 8e6623c8 | Guido Trotter | verticesByDegreeAsc :: Graph.Graph -> [Graph.Vertex] |

109 | 8e6623c8 | Guido Trotter | verticesByDegreeAsc g = map fst . sortBy (comparing snd) $ verticesDegree g |

110 | 8e6623c8 | Guido Trotter | |

111 | 742bd043 | Guido Trotter | -- | Get the neighbors of a vertex. |

112 | 742bd043 | Guido Trotter | neighbors :: Graph.Graph -> Graph.Vertex -> [Graph.Vertex] |

113 | 742bd043 | Guido Trotter | neighbors g v = g Array.! v |

114 | 742bd043 | Guido Trotter | |

115 | faef859e | Guido Trotter | -- | Check whether a graph has no loops. |

116 | faef859e | Guido Trotter | -- (vertices connected to themselves) |

117 | faef859e | Guido Trotter | hasLoop :: Graph.Graph -> Bool |

118 | faef859e | Guido Trotter | hasLoop g = any vLoops $ Graph.vertices g |

119 | faef859e | Guido Trotter | where vLoops v = v `elem` neighbors g v |

120 | faef859e | Guido Trotter | |

121 | faef859e | Guido Trotter | -- | Check whether a graph is undirected |

122 | faef859e | Guido Trotter | isUndirected :: Graph.Graph -> Bool |

123 | faef859e | Guido Trotter | isUndirected g = |

124 | faef859e | Guido Trotter | (sort . Graph.edges) g == (sort . Graph.edges . Graph.transposeG) g |

125 | faef859e | Guido Trotter | |

126 | 8e6623c8 | Guido Trotter | -- * Coloring |

127 | 8e6623c8 | Guido Trotter | |

128 | 8e6623c8 | Guido Trotter | -- | Empty color map. |

129 | 8e6623c8 | Guido Trotter | emptyVertColorMap :: VertColorMap |

130 | 8e6623c8 | Guido Trotter | emptyVertColorMap = IntMap.empty |

131 | 8e6623c8 | Guido Trotter | |

132 | faef859e | Guido Trotter | -- | Check whether a graph is colorable. |

133 | faef859e | Guido Trotter | isColorable :: Graph.Graph -> Bool |

134 | faef859e | Guido Trotter | isColorable g = isUndirected g && not (hasLoop g) |

135 | faef859e | Guido Trotter | |

136 | 742bd043 | Guido Trotter | -- | Get the colors of a list of vertices. |

137 | 742bd043 | Guido Trotter | -- Any uncolored vertices are ignored. |

138 | 8b50de5c | Guido Trotter | verticesColors :: VertColorMap -> [Graph.Vertex] -> [Color] |

139 | 8b50de5c | Guido Trotter | verticesColors cMap = mapMaybe (`IntMap.lookup` cMap) |

140 | 8b50de5c | Guido Trotter | |

141 | f127e585 | Guido Trotter | -- | Get the set of colors of a list of vertices. |

142 | 8b50de5c | Guido Trotter | -- Any uncolored vertices are ignored. |

143 | 8b50de5c | Guido Trotter | verticesColorSet :: VertColorMap -> [Graph.Vertex] -> IntSet.IntSet |

144 | f127e585 | Guido Trotter | verticesColorSet cMap = IntSet.fromList . verticesColors cMap |

145 | 742bd043 | Guido Trotter | |

146 | 8e6623c8 | Guido Trotter | -- | Get the colors of the neighbors of a vertex. |

147 | 8e6623c8 | Guido Trotter | neighColors :: Graph.Graph -> VertColorMap -> Graph.Vertex -> [Color] |

148 | 8b50de5c | Guido Trotter | neighColors g cMap v = verticesColors cMap $ neighbors g v |

149 | 8e6623c8 | Guido Trotter | |

150 | 72747d91 | Iustin Pop | {-# ANN colorNode "HLint: ignore Use alternative" #-} |

151 | 8e6623c8 | Guido Trotter | -- | Color one node. |

152 | 8e6623c8 | Guido Trotter | colorNode :: Graph.Graph -> VertColorMap -> Graph.Vertex -> Color |

153 | 8e6623c8 | Guido Trotter | -- use of "head" is A-ok as the source is an infinite list |

154 | 8e6623c8 | Guido Trotter | colorNode g cMap v = head $ filter notNeighColor [0..] |

155 | 8e6623c8 | Guido Trotter | where notNeighColor = (`notElem` neighColors g cMap v) |

156 | 8e6623c8 | Guido Trotter | |

157 | 8e6623c8 | Guido Trotter | -- | Color a node returning the updated color map. |

158 | 8e6623c8 | Guido Trotter | colorNodeInMap :: Graph.Graph -> Graph.Vertex -> VertColorMap -> VertColorMap |

159 | 8e6623c8 | Guido Trotter | colorNodeInMap g v cMap = IntMap.insert v newcolor cMap |

160 | 8e6623c8 | Guido Trotter | where newcolor = colorNode g cMap v |

161 | 8e6623c8 | Guido Trotter | |

162 | 8e6623c8 | Guido Trotter | -- | Color greedily all nodes in the given order. |

163 | 8e6623c8 | Guido Trotter | colorInOrder :: Graph.Graph -> [Graph.Vertex] -> VertColorMap |

164 | 8e6623c8 | Guido Trotter | colorInOrder g = foldr (colorNodeInMap g) emptyVertColorMap |

165 | 8e6623c8 | Guido Trotter | |

166 | 8e6623c8 | Guido Trotter | -- | Color greedily all nodes, larger first. |

167 | c94f9990 | Guido Trotter | colorLF :: Graph.Graph -> VertColorMap |

168 | c94f9990 | Guido Trotter | colorLF g = colorInOrder g $ verticesByDegreeAsc g |

169 | 8e6623c8 | Guido Trotter | |

170 | 742bd043 | Guido Trotter | -- | (vertex, (saturation, degree)) for a vertex. |

171 | 742bd043 | Guido Trotter | vertexSaturation :: Graph.Graph |

172 | 742bd043 | Guido Trotter | -> VertColorMap |

173 | 742bd043 | Guido Trotter | -> Graph.Vertex |

174 | 742bd043 | Guido Trotter | -> (Graph.Vertex, (Satur, Int)) |

175 | 8b50de5c | Guido Trotter | vertexSaturation g cMap v = |

176 | 8b50de5c | Guido Trotter | (v, (IntSet.size (verticesColorSet cMap neigh), length neigh)) |

177 | 742bd043 | Guido Trotter | where neigh = neighbors g v |

178 | 742bd043 | Guido Trotter | |

179 | 8b50de5c | Guido Trotter | -- | (vertex, (colordegree, degree)) for a vertex. |

180 | 8b50de5c | Guido Trotter | vertexColorDegree :: Graph.Graph |

181 | 8b50de5c | Guido Trotter | -> VertColorMap |

182 | 8b50de5c | Guido Trotter | -> Graph.Vertex |

183 | 8b50de5c | Guido Trotter | -> (Graph.Vertex, (Int, Int)) |

184 | 8b50de5c | Guido Trotter | vertexColorDegree g cMap v = |

185 | 8b50de5c | Guido Trotter | (v, (length (verticesColors cMap neigh), length neigh)) |

186 | 8b50de5c | Guido Trotter | where neigh = neighbors g v |

187 | 8b50de5c | Guido Trotter | |

188 | 8b50de5c | Guido Trotter | -- | Color all nodes in a dynamic order. |

189 | 742bd043 | Guido Trotter | -- We have a list of vertices still uncolored, and at each round we |

190 | 8b50de5c | Guido Trotter | -- choose&delete one vertex among the remaining ones. A helper function |

191 | 8b50de5c | Guido Trotter | -- is used to induce an order so that the next vertex can be chosen. |

192 | 8b50de5c | Guido Trotter | colorDynamicOrder :: Ord a |

193 | 8b50de5c | Guido Trotter | => (Graph.Graph |

194 | 8b50de5c | Guido Trotter | -> VertColorMap |

195 | 8b50de5c | Guido Trotter | -> Graph.Vertex |

196 | 8b50de5c | Guido Trotter | -> (Graph.Vertex, a)) -- ^ Helper to induce the choice |

197 | 8b50de5c | Guido Trotter | -> Graph.Graph -- ^ Target graph |

198 | 8b50de5c | Guido Trotter | -> VertColorMap -- ^ Accumulating vertex color map |

199 | 8b50de5c | Guido Trotter | -> [Graph.Vertex] -- ^ List of remaining vertices |

200 | 8b50de5c | Guido Trotter | -> VertColorMap -- ^ Output vertex color map |

201 | 8b50de5c | Guido Trotter | colorDynamicOrder _ _ cMap [] = cMap |

202 | 8b50de5c | Guido Trotter | colorDynamicOrder ordind g cMap l = colorDynamicOrder ordind g newmap newlist |

203 | 742bd043 | Guido Trotter | where newmap = colorNodeInMap g choosen cMap |

204 | 8b50de5c | Guido Trotter | choosen = fst . maximumBy (comparing snd) $ ordlist |

205 | 8b50de5c | Guido Trotter | ordlist = map (ordind g cMap) l |

206 | 742bd043 | Guido Trotter | newlist = delete choosen l |

207 | 742bd043 | Guido Trotter | |

208 | 8b50de5c | Guido Trotter | -- | Color greedily all nodes, highest number of colored neighbors, then |

209 | 8b50de5c | Guido Trotter | -- highest degree. This is slower than "colorLF" as we must dynamically |

210 | 8b50de5c | Guido Trotter | -- recalculate which node to color next among all remaining ones but |

211 | 8b50de5c | Guido Trotter | -- produces better results. |

212 | c94f9990 | Guido Trotter | colorDcolor :: Graph.Graph -> VertColorMap |

213 | 8b50de5c | Guido Trotter | colorDcolor g = |

214 | c94f9990 | Guido Trotter | colorDynamicOrder vertexColorDegree g emptyVertColorMap $ Graph.vertices g |

215 | 8b50de5c | Guido Trotter | |

216 | 742bd043 | Guido Trotter | -- | Color greedily all nodes, highest saturation, then highest degree. |

217 | 742bd043 | Guido Trotter | -- This is slower than "colorLF" as we must dynamically recalculate |

218 | 742bd043 | Guido Trotter | -- which node to color next among all remaining ones but produces better |

219 | 742bd043 | Guido Trotter | -- results. |

220 | c94f9990 | Guido Trotter | colorDsatur :: Graph.Graph -> VertColorMap |

221 | 742bd043 | Guido Trotter | colorDsatur g = |

222 | c94f9990 | Guido Trotter | colorDynamicOrder vertexSaturation g emptyVertColorMap $ Graph.vertices g |

223 | 742bd043 | Guido Trotter | |

224 | 8e6623c8 | Guido Trotter | -- | ColorVertMap from VertColorMap. |

225 | 8e6623c8 | Guido Trotter | colorVertMap :: VertColorMap -> ColorVertMap |

226 | 8e6623c8 | Guido Trotter | colorVertMap = IntMap.foldWithKey |

227 | 8e6623c8 | Guido Trotter | (flip (IntMap.insertWith ((:) . head)) . replicate 1) |

228 | 8e6623c8 | Guido Trotter | IntMap.empty |