Synnefo » snf-ganeti

{-| 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