Commit 8e6623c8 authored by Guido Trotter's avatar Guido Trotter

Add Ganeti.HTools.Graph

This module implements some algorithms on Data.Graph data structures.
At the moment its main functionality is an LF-color implementation
(greedy coloring in descending order of degree). There are also a few
extra functions to calculate the degree order, and convert the node to
color mapping to color to nodes.
Signed-off-by: default avatarGuido Trotter <ultrotter@google.com>
Reviewed-by: default avatarIustin Pop <iustin@google.com>
parent 402ff455
......@@ -460,6 +460,7 @@ HS_LIB_SRCS = \
htools/Ganeti/HTools/Cluster.hs \
htools/Ganeti/HTools/Container.hs \
htools/Ganeti/HTools/ExtLoader.hs \
htools/Ganeti/HTools/Graph.hs \
htools/Ganeti/HTools/Group.hs \
htools/Ganeti/HTools/Instance.hs \
htools/Ganeti/HTools/Loader.hs \
......@@ -511,6 +512,7 @@ HS_TEST_SRCS = \
htest/Test/Ganeti/HTools/CLI.hs \
htest/Test/Ganeti/HTools/Cluster.hs \
htest/Test/Ganeti/HTools/Container.hs \
htest/Test/Ganeti/HTools/Graph.hs \
htest/Test/Ganeti/HTools/Instance.hs \
htest/Test/Ganeti/HTools/Loader.hs \
htest/Test/Ganeti/HTools/Node.hs \
......
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for Ganeti.Htools.Graph
-}
{-
Copyright (C) 2009, 2010, 2011, 2012 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 Test.Ganeti.HTools.Graph (testHTools_Graph) where
import Test.QuickCheck
import Test.HUnit
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Ganeti.HTools.Graph
import qualified Data.Graph as Graph
import qualified Data.IntMap as IntMap
{-# ANN module "HLint: ignore Use camelCase" #-}
data TestableGraph = TestableGraph Graph.Graph deriving (Show)
data TestableClique = TestableClique Graph.Graph deriving (Show)
-- | Generate node bounds and edges for an undirected graph.
-- A graph is undirected if for every (a, b) edge there is a
-- corresponding (b, a) one.
undirEdges :: Gen (Graph.Bounds, [Graph.Edge])
undirEdges = sized undirEdges'
where
undirEdges' 0 = return ((0, 0), [])
undirEdges' n = do
maxv <- choose (1, n)
edges <- listOf1 $ do
i <- choose (0, maxv)
j <- choose (0, maxv) `suchThat` (/= i)
return [(i, j), (j, i)]
return ((0, maxv), concat edges)
-- | Generate node bounds and edges for a clique.
-- In a clique all nodes are directly connected to each other.
cliqueEdges :: Gen (Graph.Bounds, [Graph.Edge])
cliqueEdges = sized cliqueEdges'
where
cliqueEdges' 0 = return ((0, 0), [])
cliqueEdges' n = do
maxv <- choose (0, n)
let edges = [(x, y) | x <- [0..maxv], y <- [0..maxv], x /= y]
return ((0, maxv), edges)
instance Arbitrary TestableGraph where
arbitrary = do
(mybounds, myedges) <- undirEdges
return . TestableGraph $ Graph.buildG mybounds myedges
instance Arbitrary TestableClique where
arbitrary = do
(mybounds, myedges) <- cliqueEdges
return . TestableClique $ Graph.buildG mybounds myedges
-- | Check that the empty vertex color map is empty.
case_emptyVertColorMapNull :: Assertion
case_emptyVertColorMapNull = assertBool "" $ IntMap.null emptyVertColorMap
-- | Check that the empty vertex color map is zero in size.
case_emptyVertColorMapEmpty :: Assertion
case_emptyVertColorMapEmpty =
assertEqual "" 0 $ IntMap.size emptyVertColorMap
-- | Check that the given algorithm colors a clique with the same number of
-- colors as the vertices number.
prop_colorClique :: (Graph.Graph -> ColorVertMap) -> TestableClique -> Property
prop_colorClique alg (TestableClique g) = numvertices ==? numcolors
where numcolors = IntMap.size (alg g)
numvertices = length (Graph.vertices g)
-- | Specific check for the LF algorithm.
prop_colorLFClique :: TestableClique -> Property
prop_colorLFClique = prop_colorClique colorLF
-- Check that all nodes are colored.
prop_colorAllNodes :: (Graph.Graph -> ColorVertMap)
-> TestableGraph
-> Property
prop_colorAllNodes alg (TestableGraph g) = numvertices ==? numcolored
where numcolored = IntMap.fold (\v l -> length v + l) 0 $ alg g
numvertices = length (Graph.vertices g)
-- | Specific check for the LF algorithm.
prop_colorLFAllNodes :: TestableGraph -> Property
prop_colorLFAllNodes = prop_colorAllNodes colorLF
-- | List of tests for the Graph module.
testSuite "HTools/Graph"
[ 'case_emptyVertColorMapNull
, 'case_emptyVertColorMapEmpty
, 'prop_colorLFClique
, 'prop_colorLFAllNodes
]
......@@ -43,6 +43,7 @@ import Test.Ganeti.HTools.Backend.Text
import Test.Ganeti.HTools.CLI
import Test.Ganeti.HTools.Cluster
import Test.Ganeti.HTools.Container
import Test.Ganeti.HTools.Graph
import Test.Ganeti.HTools.Instance
import Test.Ganeti.HTools.Loader
import Test.Ganeti.HTools.Node
......@@ -90,6 +91,7 @@ allTests =
, testHTools_CLI
, testHTools_Cluster
, testHTools_Container
, testHTools_Graph
, testHTools_Instance
, testHTools_Loader
, testHTools_Node
......
{-| 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>
-}
{-
Copyright (C) 2012, 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
-- * Color map transformations
, colorVertMap
-- * Vertex sorting
, verticesByDegreeDesc
, verticesByDegreeAsc
) where
import Data.Maybe
import Data.Ord
import Data.List
import qualified Data.IntMap as IntMap
import qualified Data.Graph as Graph
import qualified Data.Array as Array
-- * Type declarations
-- | Node colors.
type Color = Int
-- | Vertex to Color association.
type VertColorMap = IntMap.IntMap Color
-- | Color to Vertex association.
type ColorVertMap = IntMap.IntMap [Int]
-- * Sorting of vertices
-- | (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
-- * Coloring
-- | Empty color map.
emptyVertColorMap :: VertColorMap
emptyVertColorMap = IntMap.empty
-- | Get the colors of the neighbors of a vertex.
neighColors :: Graph.Graph -> VertColorMap -> Graph.Vertex -> [Color]
neighColors g cMap v = mapMaybe (`IntMap.lookup` cMap) neighbors
where neighbors = g Array.! v
-- | 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 -> ColorVertMap
colorLF g = colorVertMap . colorInOrder g $ verticesByDegreeAsc g
-- | ColorVertMap from VertColorMap.
colorVertMap :: VertColorMap -> ColorVertMap
colorVertMap = IntMap.foldWithKey
(flip (IntMap.insertWith ((:) . head)) . replicate 1)
IntMap.empty
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment