diff --git a/htest/Test/Ganeti/HTools/Graph.hs b/htest/Test/Ganeti/HTools/Graph.hs index 5a2248aa2e18025bd89c578d9b564a53c6b2ada0..55ac065e29bdbb895dd7e9f309680da6344875d1 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 8f2801f499628b979e810949ea13171cd0e22d3d..a5616ecd2304cbd71e1022fd5d45aae41e6e3d68 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