Statistics
| Branch: | Tag: | Revision:

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

History | View | Annotate | Download (7.7 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 8e6623c8 Guido Trotter
Copyright (C) 2012, 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 8e6623c8 Guido Trotter
-- | Color one node.
151 8e6623c8 Guido Trotter
colorNode :: Graph.Graph -> VertColorMap -> Graph.Vertex -> Color
152 8e6623c8 Guido Trotter
-- use of "head" is A-ok as the source is an infinite list
153 8e6623c8 Guido Trotter
colorNode g cMap v = head $ filter notNeighColor [0..]
154 8e6623c8 Guido Trotter
    where notNeighColor = (`notElem` neighColors g cMap v)
155 8e6623c8 Guido Trotter
156 8e6623c8 Guido Trotter
-- | Color a node returning the updated color map.
157 8e6623c8 Guido Trotter
colorNodeInMap :: Graph.Graph -> Graph.Vertex -> VertColorMap -> VertColorMap
158 8e6623c8 Guido Trotter
colorNodeInMap g v cMap = IntMap.insert v newcolor cMap
159 8e6623c8 Guido Trotter
    where newcolor = colorNode g cMap v
160 8e6623c8 Guido Trotter
161 8e6623c8 Guido Trotter
-- | Color greedily all nodes in the given order.
162 8e6623c8 Guido Trotter
colorInOrder :: Graph.Graph -> [Graph.Vertex] -> VertColorMap
163 8e6623c8 Guido Trotter
colorInOrder g = foldr (colorNodeInMap g) emptyVertColorMap
164 8e6623c8 Guido Trotter
165 8e6623c8 Guido Trotter
-- | Color greedily all nodes, larger first.
166 c94f9990 Guido Trotter
colorLF :: Graph.Graph -> VertColorMap
167 c94f9990 Guido Trotter
colorLF g = colorInOrder g $ verticesByDegreeAsc g
168 8e6623c8 Guido Trotter
169 742bd043 Guido Trotter
-- | (vertex, (saturation, degree)) for a vertex.
170 742bd043 Guido Trotter
vertexSaturation :: Graph.Graph
171 742bd043 Guido Trotter
                 -> VertColorMap
172 742bd043 Guido Trotter
                 -> Graph.Vertex
173 742bd043 Guido Trotter
                 -> (Graph.Vertex, (Satur, Int))
174 8b50de5c Guido Trotter
vertexSaturation g cMap v =
175 8b50de5c Guido Trotter
  (v, (IntSet.size (verticesColorSet cMap neigh), length neigh))
176 742bd043 Guido Trotter
    where neigh = neighbors g v
177 742bd043 Guido Trotter
178 8b50de5c Guido Trotter
-- | (vertex, (colordegree, degree)) for a vertex.
179 8b50de5c Guido Trotter
vertexColorDegree :: Graph.Graph
180 8b50de5c Guido Trotter
                  -> VertColorMap
181 8b50de5c Guido Trotter
                  -> Graph.Vertex
182 8b50de5c Guido Trotter
                  -> (Graph.Vertex, (Int, Int))
183 8b50de5c Guido Trotter
vertexColorDegree g cMap v =
184 8b50de5c Guido Trotter
  (v, (length (verticesColors cMap neigh), length neigh))
185 8b50de5c Guido Trotter
    where neigh = neighbors g v
186 8b50de5c Guido Trotter
187 8b50de5c Guido Trotter
-- | Color all nodes in a dynamic order.
188 742bd043 Guido Trotter
-- We have a list of vertices still uncolored, and at each round we
189 8b50de5c Guido Trotter
-- choose&delete one vertex among the remaining ones. A helper function
190 8b50de5c Guido Trotter
-- is used to induce an order so that the next vertex can be chosen.
191 8b50de5c Guido Trotter
colorDynamicOrder :: Ord a
192 8b50de5c Guido Trotter
                  =>  (Graph.Graph
193 8b50de5c Guido Trotter
                      -> VertColorMap
194 8b50de5c Guido Trotter
                      -> Graph.Vertex
195 8b50de5c Guido Trotter
                      -> (Graph.Vertex, a)) -- ^ Helper to induce the choice
196 8b50de5c Guido Trotter
                  -> Graph.Graph -- ^ Target graph
197 8b50de5c Guido Trotter
                  -> VertColorMap -- ^ Accumulating vertex color map
198 8b50de5c Guido Trotter
                  -> [Graph.Vertex] -- ^ List of remaining vertices
199 8b50de5c Guido Trotter
                  -> VertColorMap -- ^ Output vertex color map
200 8b50de5c Guido Trotter
colorDynamicOrder _ _ cMap [] = cMap
201 8b50de5c Guido Trotter
colorDynamicOrder ordind g cMap l = colorDynamicOrder ordind g newmap newlist
202 742bd043 Guido Trotter
    where newmap = colorNodeInMap g choosen cMap
203 8b50de5c Guido Trotter
          choosen = fst . maximumBy (comparing snd) $ ordlist
204 8b50de5c Guido Trotter
          ordlist = map (ordind g cMap) l
205 742bd043 Guido Trotter
          newlist = delete choosen l
206 742bd043 Guido Trotter
207 8b50de5c Guido Trotter
-- | Color greedily all nodes, highest number of colored neighbors, then
208 8b50de5c Guido Trotter
-- highest degree. This is slower than "colorLF" as we must dynamically
209 8b50de5c Guido Trotter
-- recalculate which node to color next among all remaining ones but
210 8b50de5c Guido Trotter
-- produces better results.
211 c94f9990 Guido Trotter
colorDcolor :: Graph.Graph -> VertColorMap
212 8b50de5c Guido Trotter
colorDcolor g =
213 c94f9990 Guido Trotter
  colorDynamicOrder vertexColorDegree g emptyVertColorMap $ Graph.vertices g
214 8b50de5c Guido Trotter
215 742bd043 Guido Trotter
-- | Color greedily all nodes, highest saturation, then highest degree.
216 742bd043 Guido Trotter
-- This is slower than "colorLF" as we must dynamically recalculate
217 742bd043 Guido Trotter
-- which node to color next among all remaining ones but produces better
218 742bd043 Guido Trotter
-- results.
219 c94f9990 Guido Trotter
colorDsatur :: Graph.Graph -> VertColorMap
220 742bd043 Guido Trotter
colorDsatur g =
221 c94f9990 Guido Trotter
  colorDynamicOrder vertexSaturation g emptyVertColorMap $ Graph.vertices g
222 742bd043 Guido Trotter
223 8e6623c8 Guido Trotter
-- | ColorVertMap from VertColorMap.
224 8e6623c8 Guido Trotter
colorVertMap :: VertColorMap -> ColorVertMap
225 8e6623c8 Guido Trotter
colorVertMap = IntMap.foldWithKey
226 8e6623c8 Guido Trotter
                 (flip (IntMap.insertWith ((:) . head)) . replicate 1)
227 8e6623c8 Guido Trotter
                 IntMap.empty