From 8b50de5c65eda8a596749e0c53884c4fa104a450 Mon Sep 17 00:00:00 2001
From: Guido Trotter <ultrotter@google.com>
Date: Mon, 3 Dec 2012 09:25:32 +0100
Subject: [PATCH] Fix Dsatur and add Dcolor
Our Dsatur implementation was incorrect: while the paper defined the
degree of saturation of a vertex as the number of different colors it is
adjacent to, we were using the number of colors, without considering
uniqueness. This effectively implemented a different algorithm, which is
very similar to the previous one, and while it performs slightly worse
on average it still beats Dsatur on some cases.
So we refactor the implementation to effectively support both algorithms
without code duplication, and then we export both the old algorithms as
"Dcolor" and the new one as "Dsatur". Since these are all fast
algorithms in hroller we will still be able to pick the best result.
Note that the new Dsatur implementation uses an IntSet to calculate the
uniqueness. Results with nub + length on a list were significantly
slower.
Signed-off-by: Guido Trotter <ultrotter@google.com>
Reviewed-by: Iustin Pop <iustin@google.com>
---
htest/Test/Ganeti/HTools/Graph.hs | 10 +++++
htools/Ganeti/HTools/Graph.hs | 61 ++++++++++++++++++++++++-------
2 files changed, 58 insertions(+), 13 deletions(-)
diff --git a/htest/Test/Ganeti/HTools/Graph.hs b/htest/Test/Ganeti/HTools/Graph.hs
index 4ded4dbfb..5a2248aa2 100644
--- a/htest/Test/Ganeti/HTools/Graph.hs
+++ b/htest/Test/Ganeti/HTools/Graph.hs
@@ -133,6 +133,10 @@ prop_colorLFClique = prop_colorClique colorLF
prop_colorDsaturClique :: TestableClique -> Property
prop_colorDsaturClique = prop_colorClique colorDsatur
+-- | Specific check for the Dcolor algorithm.
+prop_colorDcolorClique :: TestableClique -> Property
+prop_colorDcolorClique = prop_colorClique colorDcolor
+
-- Check that all nodes are colored.
prop_colorAllNodes :: (Graph.Graph -> ColorVertMap)
-> TestableGraph
@@ -149,6 +153,10 @@ prop_colorLFAllNodes = prop_colorAllNodes colorLF
prop_colorDsaturAllNodes :: TestableGraph -> Property
prop_colorDsaturAllNodes = prop_colorAllNodes colorDsatur
+-- | Specific check for the Dcolor algorithm.
+prop_colorDcolorAllNodes :: TestableGraph -> Property
+prop_colorDcolorAllNodes = prop_colorAllNodes colorDcolor
+
-- | List of tests for the Graph module.
testSuite "HTools/Graph"
[ 'case_emptyVertColorMapNull
@@ -157,8 +165,10 @@ testSuite "HTools/Graph"
, 'prop_verticesByDegreeDescDesc
, 'prop_colorLFClique
, 'prop_colorDsaturClique
+ , 'prop_colorDcolorClique
, 'prop_colorLFAllNodes
, 'prop_colorDsaturAllNodes
+ , 'prop_colorDcolorAllNodes
, 'prop_isColorableTestableGraph
, 'prop_isColorableTestableClique
]
diff --git a/htools/Ganeti/HTools/Graph.hs b/htools/Ganeti/HTools/Graph.hs
index bdb8a334c..8f2801f49 100644
--- a/htools/Ganeti/HTools/Graph.hs
+++ b/htools/Ganeti/HTools/Graph.hs
@@ -58,6 +58,7 @@ module Ganeti.HTools.Graph
, colorInOrder
, colorLF
, colorDsatur
+ , colorDcolor
, isColorable
-- * Color map transformations
, colorVertMap
@@ -74,6 +75,7 @@ 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
@@ -133,12 +135,17 @@ isColorable g = isUndirected g && not (hasLoop g)
-- | Get the colors of a list of vertices.
-- Any uncolored vertices are ignored.
-listColors :: VertColorMap -> [Graph.Vertex] -> [Color]
-listColors cMap = mapMaybe (`IntMap.lookup` cMap)
+verticesColors :: VertColorMap -> [Graph.Vertex] -> [Color]
+verticesColors cMap = mapMaybe (`IntMap.lookup` cMap)
+
+-- | Get the colors of a list of vertices.
+-- Any uncolored vertices are ignored.
+verticesColorSet :: VertColorMap -> [Graph.Vertex] -> IntSet.IntSet
+verticesColorSet cMap = IntSet.fromList . mapMaybe (`IntMap.lookup` cMap)
-- | Get the colors of the neighbors of a vertex.
neighColors :: Graph.Graph -> VertColorMap -> Graph.Vertex -> [Color]
-neighColors g cMap v = listColors cMap $ neighbors g v
+neighColors g cMap v = verticesColors cMap $ neighbors g v
-- | Color one node.
colorNode :: Graph.Graph -> VertColorMap -> Graph.Vertex -> Color
@@ -164,28 +171,56 @@ vertexSaturation :: Graph.Graph
-> VertColorMap
-> Graph.Vertex
-> (Graph.Vertex, (Satur, Int))
-vertexSaturation g cMap v = (v, (length (listColors cMap neigh), length neigh))
+vertexSaturation g cMap v =
+ (v, (IntSet.size (verticesColorSet cMap neigh), length neigh))
where neigh = neighbors g v
--- | Auxiliary recursive function to calculate dsatur.
+-- | (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 the maximum saturation vertex among the remaining ones.
--- To do so we need explicit recursion.
-colorDsatur' :: Graph.Graph -> VertColorMap -> [Graph.Vertex] -> VertColorMap
-colorDsatur' _ cMap [] = cMap
-colorDsatur' g cMap l = colorDsatur' g newmap newlist
+-- 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) $ satlist
- satlist = map (vertexSaturation g cMap) l
+ 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 -> ColorVertMap
+colorDcolor g =
+ colorVertMap . colorDynamicOrder vertexColorDegree g emptyVertColorMap $ vert
+ where vert = 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 -> ColorVertMap
colorDsatur g =
- colorVertMap . colorDsatur' g emptyVertColorMap $ Graph.vertices g
+ colorVertMap . colorDynamicOrder vertexSaturation g emptyVertColorMap $ vert
+ where vert = Graph.vertices g
-- | ColorVertMap from VertColorMap.
colorVertMap :: VertColorMap -> ColorVertMap
--
GitLab