{- |
Alternative to "Math.SetCover.Exact" that uses a priority queue
and avoids full scans through available sets.
-}
module Math.SetCover.Queue.Set (Methods, methods) where

import qualified Math.SetCover.Queue as Queue
import Math.SetCover.Queue (SetId)

import qualified Math.SetCover.EnumMap as EnumMapX
import qualified Data.OrdPSQ as PSQ
import qualified Data.EnumSet as EnumSet; import Data.EnumSet (EnumSet)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.List as List
import Data.Tuple.HT (swap, mapFst, thd3)


type Methods a = Queue.Methods (PSQ.OrdPSQ a Int (EnumSet SetId)) (Set.Set a)

methods :: Ord a => Methods a
methods =
   Queue.Methods {
      Queue.fromEnumMap =
         PSQ.fromList . map (\(elm, ns) -> (elm, EnumSet.size ns, ns)) .
         Map.toList . EnumMapX.transposeSet,
      Queue.partition =
         \q -> mapFst EnumSet.unions . partitionPSQ q . Set.toList,
      Queue.difference = \q ->
         foldl (flip deleteSetFromPSQ) q . Map.toList . EnumMapX.transposeSet,
      Queue.findMin = fmap thd3 . PSQ.findMin,
      Queue.null = PSQ.null
   }

{- |
The list of keys must be a subset of the queue keys.
-}
partitionPSQ ::
   (Ord k, Ord p) => PSQ.OrdPSQ k p v -> [k] -> ([v], PSQ.OrdPSQ k p v)
partitionPSQ =
   (swap .) .
   List.mapAccumL
      (\q0 k ->
         maybe
            (error "partitionPSQ: key not contained in queue's key set")
            (\(_p,v,q1) -> (q1, v)) $
         PSQ.deleteView k q0)

deleteSetFromPSQ ::
   (Ord k) =>
   (k, EnumSet e) -> PSQ.OrdPSQ k Int (EnumSet e) ->
   PSQ.OrdPSQ k Int (EnumSet e)
deleteSetFromPSQ (elm, ns) =
   updatePSQ (flip differenceSizedSet ns) elm

differenceSizedSet :: (Int, EnumSet e) -> EnumSet e -> (Int, EnumSet e)
differenceSizedSet (size, a) b =
   let section = EnumSet.intersection a b
   in  (size - EnumSet.size section, EnumSet.difference a section)

updatePSQ ::
   (Ord p, Ord k) =>
   ((p, v) -> (p, v)) -> k -> PSQ.OrdPSQ k p v -> PSQ.OrdPSQ k p v
updatePSQ f k = snd . PSQ.alter ((,) () . fmap f) k