hgraph-1.2.0.0: src/HGraph/Undirected/Solvers/IndependentSet.hs

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)