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

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