code.grnet.gr Git - ganeti-local/blob - htools/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, 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