{-| 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:
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
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
Also interesting:
Klotz, W. (2002). Graph coloring algorithms. Mathematics Report, Technical
University Clausthal, 1-9.
-}
{-
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