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

@@ -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
             ]

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