root / src / Ganeti / HTools / Graph.hs @ a37549ea
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 |