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

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: default avatarGuido Trotter <ultrotter@google.com>
Reviewed-by: default avatarIustin Pop <iustin@google.com>
parent dae1f9cb
......@@ -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
]
......@@ -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
......
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