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     -- * Color map transformations
  62   , colorVertMap
  63     -- * Vertex sorting
  64   , verticesByDegreeDesc
  65   , verticesByDegreeAsc
  66   ) where
  67
  68 import Data.Maybe
  69 import Data.Ord
  70 import Data.List
  71
  72 import qualified Data.IntMap as IntMap
  73 import qualified Data.Graph as Graph
  74 import qualified Data.Array as Array
  75
  76 -- * Type declarations
  77
  78 -- | Node colors.
  79 type Color = Int
  80
  81 -- | Saturation: number of colored neighbors.
  82 type Satur = Int
  83
  84 -- | Vertex to Color association.
  85 type VertColorMap = IntMap.IntMap Color
  86
  87 -- | Color to Vertex association.
  88 type ColorVertMap = IntMap.IntMap [Int]
  89
  90 -- * Vertices characteristics
  91
  92 -- | (vertex, degree) tuples on a graph.
  93 verticesDegree :: Graph.Graph -> [(Graph.Vertex, Int)]
  94 verticesDegree g = Array.assocs $ Graph.outdegree g
  95
  96 -- | vertices of a graph, sorted by ascending degree.
  97 verticesByDegreeDesc :: Graph.Graph -> [Graph.Vertex]
  98 verticesByDegreeDesc g =
  99   map fst . sortBy (flip (comparing snd)) $ verticesDegree g
 100
 101 -- | vertices of a graph, sorted by descending degree.
 102 verticesByDegreeAsc :: Graph.Graph -> [Graph.Vertex]
 103 verticesByDegreeAsc g = map fst . sortBy (comparing snd) $ verticesDegree g
 104
 105 -- | Get the neighbors of a vertex.
 106 neighbors :: Graph.Graph -> Graph.Vertex -> [Graph.Vertex]
 107 neighbors g v = g Array.! v
 108
 109 -- * Coloring
 110
 111 -- | Empty color map.
 112 emptyVertColorMap :: VertColorMap
 113 emptyVertColorMap = IntMap.empty
 114
 115 -- | Get the colors of a list of vertices.
 116 -- Any uncolored vertices are ignored.
 117 listColors :: VertColorMap -> [Graph.Vertex] -> [Color]
 118 listColors cMap = mapMaybe (`IntMap.lookup` cMap)
 119
 120 -- | Get the colors of the neighbors of a vertex.
 121 neighColors :: Graph.Graph -> VertColorMap -> Graph.Vertex -> [Color]
 122 neighColors g cMap v = listColors cMap $ neighbors g v
 123
 124 -- | Color one node.
 125 colorNode :: Graph.Graph -> VertColorMap -> Graph.Vertex -> Color
 126 -- use of "head" is A-ok as the source is an infinite list
 127 colorNode g cMap v = head $ filter notNeighColor [0..]
 128     where notNeighColor = (`notElem` neighColors g cMap v)
 129
 130 -- | Color a node returning the updated color map.
 131 colorNodeInMap :: Graph.Graph -> Graph.Vertex -> VertColorMap -> VertColorMap
 132 colorNodeInMap g v cMap = IntMap.insert v newcolor cMap
 133     where newcolor = colorNode g cMap v
 134
 135 -- | Color greedily all nodes in the given order.
 136 colorInOrder :: Graph.Graph -> [Graph.Vertex] -> VertColorMap
 137 colorInOrder g = foldr (colorNodeInMap g) emptyVertColorMap
 138
 139 -- | Color greedily all nodes, larger first.
 140 colorLF :: Graph.Graph -> ColorVertMap
 141 colorLF g = colorVertMap . colorInOrder g $ verticesByDegreeAsc g
 142
 143 -- | (vertex, (saturation, degree)) for a vertex.
 144 vertexSaturation :: Graph.Graph
 145                  -> VertColorMap
 146                  -> Graph.Vertex
 147                  -> (Graph.Vertex, (Satur, Int))
 148 vertexSaturation g cMap v = (v, (length (listColors cMap neigh), length neigh))
 149     where neigh = neighbors g v
 150
 151 -- | Auxiliary recursive function to calculate dsatur.
 152 -- We have a list of vertices still uncolored, and at each round we
 153 -- choose&delete the maximum saturation vertex among the remaining ones.
 154 -- To do so we need explicit recursion.
 155 colorDsatur' :: Graph.Graph -> VertColorMap -> [Graph.Vertex] -> VertColorMap
 156 colorDsatur' _ cMap [] = cMap
 157 colorDsatur' g cMap l = colorDsatur' g newmap newlist
 158     where newmap = colorNodeInMap g choosen cMap
 159           choosen = fst . maximumBy (comparing snd) $ satlist
 160           satlist = map (vertexSaturation g cMap) l
 161           newlist = delete choosen l
 162
 163 -- | Color greedily all nodes, highest saturation, then highest degree.
 164 -- This is slower than "colorLF" as we must dynamically recalculate
 165 -- which node to color next among all remaining ones but produces better
 166 -- results.
 167 colorDsatur :: Graph.Graph -> ColorVertMap
 168 colorDsatur g =
 169   colorVertMap . colorDsatur' g emptyVertColorMap $ Graph.vertices g
 170
 171 -- | ColorVertMap from VertColorMap.
 172 colorVertMap :: VertColorMap -> ColorVertMap
 173 colorVertMap = IntMap.foldWithKey
 174                  (flip (IntMap.insertWith ((:) . head)) . replicate 1)
 175                  IntMap.empty