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 :: t a -> [a]
maximize t a
g = [[a]] -> [a]
forall a. [a] -> a
last [Maybe [a] -> [a]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe [a]
x | Int
k <- [Int
1..t a -> Int
forall (t :: * -> *) b a.
(UndirectedGraph t, Integral b) =>
t a -> b
numVertices t a
g], let x :: Maybe [a]
x = t a -> Int -> Maybe [a]
forall (t :: * -> *) a.
(Adjacency t, Mutable t) =>
t a -> Int -> Maybe [a]
atLeast t a
g Int
k, Maybe [a] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [a]
x]

-- | Search for an independent set of size at least `k` in `g`
atLeast :: t a -> Int -> Maybe [a]
atLeast t a
g Int
k
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [a] -> Maybe [a]
forall a. a -> Maybe a
Just []
  | t a -> Integer
forall (t :: * -> *) b a.
(UndirectedGraph t, Integral b) =>
t a -> b
numVertices t a
g Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Maybe [a]
forall a. Maybe a
Nothing
  | Bool
otherwise = 
    let (t a
g', [a]
xs, Int
k') = t a -> Int -> (t a, [a], Int)
forall (t :: * -> *) a.
(Adjacency t, Mutable t) =>
t a -> Int -> (t a, [a], Int)
reduce t a
g Int
k
    in
    if Int
k' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k then
      [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
xs
    else
      ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) (Maybe [a] -> Maybe [a]) -> Maybe [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ 
        [[a]] -> Maybe [a]
forall a. [a] -> Maybe a
mhead [ a
u a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Maybe [a] -> [a]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe [a]
ys
              | a
u <- t a -> [a]
forall (t :: * -> *) a. UndirectedGraph t => t a -> [a]
vertices t a
g'
              , let ys :: Maybe [a]
ys = t a -> Int -> Maybe [a]
atLeast ((a -> t a -> t a) -> t a -> [a] -> t a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((t a -> a -> t a) -> a -> t a -> t a
forall a b c. (a -> b -> c) -> b -> a -> c
flip t a -> a -> t a
forall (t :: * -> *) a. Mutable t => t a -> a -> t a
removeVertex) t a
g' ([a] -> t a) -> [a] -> t a
forall a b. (a -> b) -> a -> b
$ a
u a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
neighbors t a
g' a
u) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k')
              , Maybe [a] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [a]
ys]

reduce :: t a -> Int -> (t a, [a], Int)
reduce t a
g Int
k
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (t a
g, [], Int
0)
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (t a -> Int
forall (t :: * -> *) b a.
(UndirectedGraph t, Integral b) =>
t a -> b
numVertices t a
g) Bool -> Bool -> Bool
|| (Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (t a -> Int
forall (t :: * -> *) b a.
(UndirectedGraph t, Integral b) =>
t a -> b
numVertices t a
g) Bool -> Bool -> Bool
&& t a -> Integer
forall (t :: * -> *) b a.
(UndirectedGraph t, Integral b) =>
t a -> b
numEdges t a
g Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) = (t a -> t a
forall (t :: * -> *) a. UndirectedGraph t => t a -> t a
empty t a
g, [], Int
0)
  | Bool
otherwise = 
    let xs0 :: [a]
xs0 = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\a
v -> t a -> a -> Integer
forall (t :: * -> *) b a.
(Adjacency t, Integral b) =>
t a -> a -> b
degree t a
g a
v Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ t a -> [a]
forall (t :: * -> *) a. UndirectedGraph t => t a -> [a]
vertices t a
g
        xsn :: [a]
xsn = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\a
v -> t a -> a -> Int
forall (t :: * -> *) b a.
(Adjacency t, Integral b) =>
t a -> a -> b
degree t a
g a
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (t a -> Int
forall (t :: * -> *) b a.
(UndirectedGraph t, Integral b) =>
t a -> b
numVertices t a
g) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ t a -> [a]
forall (t :: * -> *) a. UndirectedGraph t => t a -> [a]
vertices t a
g
        g' :: t a
g' = (a -> t a -> t a) -> t a -> [a] -> t a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((t a -> a -> t a) -> a -> t a -> t a
forall a b c. (a -> b -> c) -> b -> a -> c
flip t a -> a -> t a
forall (t :: * -> *) a. Mutable t => t a -> a -> t a
removeVertex) t a
g ([a]
xsn [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs0)
        x1 :: [a]
x1  = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
1 ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\a
v -> t a -> a -> Integer
forall (t :: * -> *) b a.
(Adjacency t, Integral b) =>
t a -> a -> b
degree t a
g' a
v Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ t a -> [a]
forall (t :: * -> *) a. UndirectedGraph t => t a -> [a]
vertices t a
g'
    in case [a]
x1 of
        [a
v] ->
          let k0 :: Int
k0 = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs0
              g'' :: t a
g'' = (a -> t a -> t a) -> t a -> [a] -> t a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((t a -> a -> t a) -> a -> t a -> t a
forall a b c. (a -> b -> c) -> b -> a -> c
flip t a -> a -> t a
forall (t :: * -> *) a. Mutable t => t a -> a -> t a
removeVertex) t a
g' ([a] -> t a) -> [a] -> t a
forall a b. (a -> b) -> a -> b
$ a
v a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
neighbors t a
g' a
v
              (t a
g''', [a]
xs', Int
k') = t a -> Int -> (t a, [a], Int)
reduce t a
g'' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          in (t a
g''', a
va -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs', Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k')
        [] -> (t a
g', [a]
xs0, [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs0)