{-| Algorithms on Graphs. This module contains a few graph algorithms and the transoformations needed for them to be used on nodes. For more information about Graph Coloring see: <http://en.wikipedia.org/wiki/Graph_coloring> <http://en.wikipedia.org/wiki/Greedy_coloring> LF-coloring is described in: Welsh, D. J. A.; Powell, M. B. (1967), "An upper bound for the chromatic number of a graph and its application to timetabling problems", The Computer Journal 10 (1): 85-86, doi:10.1093/comjnl/10.1.85 <http://comjnl.oxfordjournals.org/content/10/1/85> DSatur is described in: Brelaz, D. (1979), "New methods to color the vertices of a graph", Communications of the ACM 22 (4): 251-256, doi:10.1145/359094.359101 <http://dx.doi.org/10.1145%2F359094.359101> Also interesting: Klotz, W. (2002). Graph coloring algorithms. Mathematics Report, Technical University Clausthal, 1-9. <http://www.math.tu-clausthal.de/Arbeitsgruppen/Diskrete-Optimierung /publications/2002/gca.pdf> -} {- Copyright (C) 2012, 2013, Google Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -} module Ganeti.HTools.Graph ( -- * Types Color , VertColorMap , ColorVertMap -- * Creation , emptyVertColorMap -- * Coloring , colorInOrder , colorLF , colorDsatur , colorDcolor , isColorable -- * Color map transformations , colorVertMap -- * Vertex characteristics , verticesByDegreeDesc , verticesByDegreeAsc , neighbors , hasLoop , isUndirected ) where import Data.Maybe import Data.Ord import Data.List import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet import qualified Data.Graph as Graph import qualified Data.Array as Array -- * Type declarations -- | Node colors. type Color = Int -- | Saturation: number of colored neighbors. type Satur = Int -- | Vertex to Color association. type VertColorMap = IntMap.IntMap Color -- | Color to Vertex association. type ColorVertMap = IntMap.IntMap [Int] -- * Vertices characteristics -- | (vertex, degree) tuples on a graph. verticesDegree :: Graph.Graph -> [(Graph.Vertex, Int)] verticesDegree g = Array.assocs $ Graph.outdegree g -- | vertices of a graph, sorted by ascending degree. verticesByDegreeDesc :: Graph.Graph -> [Graph.Vertex] verticesByDegreeDesc g = map fst . sortBy (flip (comparing snd)) $ verticesDegree g -- | vertices of a graph, sorted by descending degree. verticesByDegreeAsc :: Graph.Graph -> [Graph.Vertex] verticesByDegreeAsc g = map fst . sortBy (comparing snd) $ verticesDegree g -- | Get the neighbors of a vertex. neighbors :: Graph.Graph -> Graph.Vertex -> [Graph.Vertex] neighbors g v = g Array.! v -- | Check whether a graph has no loops. -- (vertices connected to themselves) hasLoop :: Graph.Graph -> Bool hasLoop g = any vLoops $ Graph.vertices g where vLoops v = v `elem` neighbors g v -- | Check whether a graph is undirected isUndirected :: Graph.Graph -> Bool isUndirected g = (sort . Graph.edges) g == (sort . Graph.edges . Graph.transposeG) g -- * Coloring -- | Empty color map. emptyVertColorMap :: VertColorMap emptyVertColorMap = IntMap.empty -- | Check whether a graph is colorable. isColorable :: Graph.Graph -> Bool isColorable g = isUndirected g && not (hasLoop g) -- | Get the colors of a list of vertices. -- Any uncolored vertices are ignored. verticesColors :: VertColorMap -> [Graph.Vertex] -> [Color] verticesColors cMap = mapMaybe (`IntMap.lookup` cMap) -- | Get the set of colors of a list of vertices. -- Any uncolored vertices are ignored. verticesColorSet :: VertColorMap -> [Graph.Vertex] -> IntSet.IntSet verticesColorSet cMap = IntSet.fromList . verticesColors cMap -- | Get the colors of the neighbors of a vertex. neighColors :: Graph.Graph -> VertColorMap -> Graph.Vertex -> [Color] neighColors g cMap v = verticesColors cMap $ neighbors g v {-# ANN colorNode "HLint: ignore Use alternative" #-} -- | Color one node. colorNode :: Graph.Graph -> VertColorMap -> Graph.Vertex -> Color -- use of "head" is A-ok as the source is an infinite list colorNode g cMap v = head $ filter notNeighColor [0..] where notNeighColor = (`notElem` neighColors g cMap v) -- | Color a node returning the updated color map. colorNodeInMap :: Graph.Graph -> Graph.Vertex -> VertColorMap -> VertColorMap colorNodeInMap g v cMap = IntMap.insert v newcolor cMap where newcolor = colorNode g cMap v -- | Color greedily all nodes in the given order. colorInOrder :: Graph.Graph -> [Graph.Vertex] -> VertColorMap colorInOrder g = foldr (colorNodeInMap g) emptyVertColorMap -- | Color greedily all nodes, larger first. colorLF :: Graph.Graph -> VertColorMap colorLF g = colorInOrder g $ verticesByDegreeAsc g -- | (vertex, (saturation, degree)) for a vertex. vertexSaturation :: Graph.Graph -> VertColorMap -> Graph.Vertex -> (Graph.Vertex, (Satur, Int)) vertexSaturation g cMap v = (v, (IntSet.size (verticesColorSet cMap neigh), length neigh)) where neigh = neighbors g v -- | (vertex, (colordegree, degree)) for a vertex. vertexColorDegree :: Graph.Graph -> VertColorMap -> Graph.Vertex -> (Graph.Vertex, (Int, Int)) vertexColorDegree g cMap v = (v, (length (verticesColors cMap neigh), length neigh)) where neigh = neighbors g v -- | Color all nodes in a dynamic order. -- We have a list of vertices still uncolored, and at each round we -- choose&delete one vertex among the remaining ones. A helper function -- is used to induce an order so that the next vertex can be chosen. colorDynamicOrder :: Ord a => (Graph.Graph -> VertColorMap -> Graph.Vertex -> (Graph.Vertex, a)) -- ^ Helper to induce the choice -> Graph.Graph -- ^ Target graph -> VertColorMap -- ^ Accumulating vertex color map -> [Graph.Vertex] -- ^ List of remaining vertices -> VertColorMap -- ^ Output vertex color map colorDynamicOrder _ _ cMap [] = cMap colorDynamicOrder ordind g cMap l = colorDynamicOrder ordind g newmap newlist where newmap = colorNodeInMap g choosen cMap choosen = fst . maximumBy (comparing snd) $ ordlist ordlist = map (ordind g cMap) l newlist = delete choosen l -- | Color greedily all nodes, highest number of colored neighbors, then -- highest degree. This is slower than "colorLF" as we must dynamically -- recalculate which node to color next among all remaining ones but -- produces better results. colorDcolor :: Graph.Graph -> VertColorMap colorDcolor g = colorDynamicOrder vertexColorDegree g emptyVertColorMap $ Graph.vertices g -- | Color greedily all nodes, highest saturation, then highest degree. -- This is slower than "colorLF" as we must dynamically recalculate -- which node to color next among all remaining ones but produces better -- results. colorDsatur :: Graph.Graph -> VertColorMap colorDsatur g = colorDynamicOrder vertexSaturation g emptyVertColorMap $ Graph.vertices g -- | ColorVertMap from VertColorMap. colorVertMap :: VertColorMap -> ColorVertMap colorVertMap = IntMap.foldWithKey (flip (IntMap.insertWith ((:) . head)) . replicate 1) IntMap.empty