module HGraph.Undirected.Solvers.IndependentSet ( maximize , atLeast , reduce ) where import Data.Maybe import HGraph.Undirected import HGraph.Utils -- | Find a maximum independet set in `g` maximize g = last [fromJust x | k <- [1..numVertices g], let x = atLeast g k, isJust x] -- | Search for an independent set of size at least `k` in `g` atLeast g k | k <= 0 = Just [] | numVertices g == 0 = Nothing | otherwise = let (g', xs, k') = reduce g k in if k' >= k then Just xs else fmap (xs ++) $ mhead [ u : fromJust ys | u <- vertices g' , let ys = atLeast (foldr (flip removeVertex) g' $ u : neighbors g' u) (k - 1 - k') , isJust ys] reduce g k | k <= 0 = (g, [], 0) | k > (numVertices g) || (k == (numVertices g) && numEdges g > 0) = (empty g, [], 0) | otherwise = let xs0 = filter (\v -> degree g v == 0) $ vertices g xsn = filter (\v -> degree g v >= (numVertices g) - k + 1) $ vertices g g' = foldr (flip removeVertex) g (xsn ++ xs0) x1 = take 1 $ filter (\v -> degree g' v == 1) $ vertices g' in case x1 of [v] -> let k0 = length xs0 g'' = foldr (flip removeVertex) g' $ v : neighbors g' v (g''', xs', k') = reduce g'' (k - k0 - 1) in (g''', v:xs0 ++ xs', 1 + k0 + k') [] -> (g', xs0, length xs0)