{-# OPTIONS_GHC -Wall #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Combinatorial.HittingSet.Simple
-- Copyright   :  (c) Masahiro Sakai 2012-2014
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-----------------------------------------------------------------------------
module ToySolver.Combinatorial.HittingSet.Simple
  ( minimalHittingSets
  , enumMinimalHittingSets
  ) where

import Control.Monad
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Set (Set)
import qualified Data.Set as Set
import ToySolver.Combinatorial.HittingSet.Util (maintainNoSupersets)

minimalHittingSets :: Set IntSet -> Set IntSet
minimalHittingSets :: Set IntSet -> Set IntSet
minimalHittingSets = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IntSet] -> [IntSet]
minimalHittingSets' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList

enumMinimalHittingSets :: Set IntSet -> [IntSet]
enumMinimalHittingSets :: Set IntSet -> [IntSet]
enumMinimalHittingSets = forall a. Ord a => [a] -> [a]
nubOrd forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IntSet] -> [IntSet]
minimalHittingSets' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList

minimalHittingSets' :: [IntSet] -> [IntSet]
minimalHittingSets' :: [IntSet] -> [IntSet]
minimalHittingSets' [IntSet]
es = [IntSet] -> IntSet -> [IntSet]
f [IntSet]
es IntSet
IntSet.empty
  where
    f :: [IntSet] -> IntSet -> [IntSet]
    f :: [IntSet] -> IntSet -> [IntSet]
f [] IntSet
hs = forall (m :: * -> *) a. Monad m => a -> m a
return IntSet
hs
    f [IntSet]
es IntSet
hs = do
      Key
v <- IntSet -> [Key]
IntSet.toList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IntSet.unions [IntSet]
es
      let hs' :: IntSet
hs' = Key -> IntSet -> IntSet
IntSet.insert Key
v IntSet
hs
      IntSet
e <- [IntSet]
es
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Key
v Key -> IntSet -> Bool
`IntSet.member` IntSet
e
      let es' :: [IntSet]
es' = [IntSet] -> Key -> IntSet -> [IntSet]
propagateChoice [IntSet]
es Key
v IntSet
e
      [IntSet] -> IntSet -> [IntSet]
f [IntSet]
es' IntSet
hs'

propagateChoice :: [IntSet] -> Int -> IntSet -> [IntSet]
propagateChoice :: [IntSet] -> Key -> IntSet -> [IntSet]
propagateChoice [IntSet]
es Key
v IntSet
e = [IntSet]
zs
  where
    xs :: [IntSet]
xs = forall a. (a -> Bool) -> [a] -> [a]
filter (Key
v Key -> IntSet -> Bool
`IntSet.notMember`) [IntSet]
es
    ys :: [IntSet]
ys = forall a b. (a -> b) -> [a] -> [b]
map ((Key -> Bool) -> IntSet -> IntSet
IntSet.filter (Key
v forall a. Ord a => a -> a -> Bool
<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntSet -> IntSet -> IntSet
`IntSet.difference` IntSet
e)) [IntSet]
xs
    zs :: [IntSet]
zs = [IntSet] -> [IntSet]
maintainNoSupersets [IntSet]
ys

nubOrd :: Ord a => [a] -> [a]
nubOrd :: forall a. Ord a => [a] -> [a]
nubOrd = forall {a}. Ord a => Set a -> [a] -> [a]
go forall a. Set a
Set.empty
  where
    go :: Set a -> [a] -> [a]
go Set a
occurred (a
x:[a]
xs)
      | a
x forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
occurred = Set a -> [a] -> [a]
go Set a
occurred [a]
xs
      | Bool
otherwise = a
x forall a. a -> [a] -> [a]
: Set a -> [a] -> [a]
go (forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
occurred) [a]
xs
    go Set a
_ [] = []