From c94f9990e504a4f807dbb7e0cd0cfd41be427c1a Mon Sep 17 00:00:00 2001
From: Guido Trotter <ultrotter@google.com>
Date: Mon, 3 Dec 2012 14:13:34 +0100
Subject: [PATCH] Add "proper coloring" unittest check

We have to check that for each edge its vertices have different colors.

This is very easy to do with a vertex-to-color map, but not so easy with
a color-to-vertex one. Since all our coloring algorithms created a
vertex-to-color map behind the scenes and then converted it, we flip
them back to returning it directly, and do the conversion explicitly
where we need it (which for now is everywhere except when testing this
property).

Signed-off-by: Guido Trotter <ultrotter@google.com>
Reviewed-by: Iustin Pop <iustin@google.com>
---
 htest/Test/Ganeti/HTools/Graph.hs | 32 +++++++++++++++++++++++++++----
 htools/Ganeti/HTools/Graph.hs     | 14 ++++++--------
 2 files changed, 34 insertions(+), 12 deletions(-)

diff --git a/htest/Test/Ganeti/HTools/Graph.hs b/htest/Test/Ganeti/HTools/Graph.hs
index 5a2248aa2..55ac065e2 100644
--- a/htest/Test/Ganeti/HTools/Graph.hs
+++ b/htest/Test/Ganeti/HTools/Graph.hs
@@ -120,9 +120,9 @@ prop_isColorableTestableClique (TestableClique g) = isColorable g ==? True
 
 -- | 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 :: (Graph.Graph -> VertColorMap) -> TestableClique -> Property
 prop_colorClique alg (TestableClique g) = numvertices ==? numcolors
-    where numcolors = IntMap.size (alg g)
+    where numcolors = (IntMap.size . colorVertMap) $ alg g
           numvertices = length (Graph.vertices g)
 
 -- | Specific check for the LF algorithm.
@@ -138,11 +138,12 @@ prop_colorDcolorClique :: TestableClique -> Property
 prop_colorDcolorClique = prop_colorClique colorDcolor
 
 -- Check that all nodes are colored.
-prop_colorAllNodes :: (Graph.Graph -> ColorVertMap)
+prop_colorAllNodes :: (Graph.Graph -> VertColorMap)
                    -> TestableGraph
                    -> Property
 prop_colorAllNodes alg (TestableGraph g) = numvertices ==? numcolored
-    where numcolored = IntMap.fold (\v l -> length v + l) 0 $ alg g
+    where numcolored = IntMap.fold ((+) . length) 0 vcMap
+          vcMap = colorVertMap $ alg g
           numvertices = length (Graph.vertices g)
 
 -- | Specific check for the LF algorithm.
@@ -157,6 +158,26 @@ prop_colorDsaturAllNodes = prop_colorAllNodes colorDsatur
 prop_colorDcolorAllNodes :: TestableGraph -> Property
 prop_colorDcolorAllNodes = prop_colorAllNodes colorDcolor
 
+-- | Check that no two vertices sharing the same edge have the same color.
+prop_colorProper :: (Graph.Graph -> VertColorMap) -> TestableGraph -> Bool
+prop_colorProper alg (TestableGraph g) = all isEdgeOk $ Graph.edges g
+    where isEdgeOk :: Graph.Edge -> Bool
+          isEdgeOk (v1, v2) = color v1 /= color v2
+          color v = cMap IntMap.! v
+          cMap = alg g
+
+-- | Specific check for the LF algorithm.
+prop_colorLFProper :: TestableGraph -> Bool
+prop_colorLFProper = prop_colorProper colorLF
+
+-- | Specific check for the Dsatur algorithm.
+prop_colorDsaturProper :: TestableGraph -> Bool
+prop_colorDsaturProper = prop_colorProper colorDsatur
+
+-- | Specific check for the Dcolor algorithm.
+prop_colorDcolorProper :: TestableGraph -> Bool
+prop_colorDcolorProper = prop_colorProper colorDcolor
+
 -- | List of tests for the Graph module.
 testSuite "HTools/Graph"
             [ 'case_emptyVertColorMapNull
@@ -169,6 +190,9 @@ testSuite "HTools/Graph"
             , 'prop_colorLFAllNodes
             , 'prop_colorDsaturAllNodes
             , 'prop_colorDcolorAllNodes
+            , 'prop_colorLFProper
+            , 'prop_colorDsaturProper
+            , 'prop_colorDcolorProper
             , 'prop_isColorableTestableGraph
             , 'prop_isColorableTestableClique
             ]
diff --git a/htools/Ganeti/HTools/Graph.hs b/htools/Ganeti/HTools/Graph.hs
index 8f2801f49..a5616ecd2 100644
--- a/htools/Ganeti/HTools/Graph.hs
+++ b/htools/Ganeti/HTools/Graph.hs
@@ -163,8 +163,8 @@ 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
+colorLF :: Graph.Graph -> VertColorMap
+colorLF g = colorInOrder g $ verticesByDegreeAsc g
 
 -- | (vertex, (saturation, degree)) for a vertex.
 vertexSaturation :: Graph.Graph
@@ -208,19 +208,17 @@ colorDynamicOrder ordind g cMap l = colorDynamicOrder ordind g newmap newlist
 -- 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 :: Graph.Graph -> VertColorMap
 colorDcolor g =
-  colorVertMap . colorDynamicOrder vertexColorDegree g emptyVertColorMap $ vert
-    where vert = Graph.vertices 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 -> ColorVertMap
+colorDsatur :: Graph.Graph -> VertColorMap
 colorDsatur g =
-  colorVertMap . colorDynamicOrder vertexSaturation g emptyVertColorMap $ vert
-    where vert = Graph.vertices g
+  colorDynamicOrder vertexSaturation g emptyVertColorMap $ Graph.vertices g
 
 -- | ColorVertMap from VertColorMap.
 colorVertMap :: VertColorMap -> ColorVertMap
-- 
GitLab