code.grnet.gr Git - ganeti-local/blob - src/Ganeti/HTools/Graph.hs

   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