{- |
This implementation uses priority queues
and avoids full scans through available sets.
It can be faster than "Math.SetCover.Exact"
if there is a huge number of sets.
-}
module Math.SetCover.Exact.Priority (
   Assign, ESC.label, ESC.labeledSet, ESC.assign,
   partitions, search, step,
   State(..), initState, updateState,
   Tree(..), decisionTree, completeTree,
   SetId, queueMap, queueSet, queueBit, queueBitPQ, queueIntSet,
   ) where

import qualified Math.SetCover.Queue.Map as QueueMap
import qualified Math.SetCover.Queue.Set as QueueSet
import qualified Math.SetCover.Queue.Bit as QueueBit
import qualified Math.SetCover.Queue.BitPriorityQueue as QueueBitPQ

import qualified Math.SetCover.BitPosition as BitPos

import qualified Math.SetCover.Queue as Queue
import qualified Math.SetCover.Exact as ESC
import Math.SetCover.Queue (Methods, SetId(SetId))
import Math.SetCover.Exact (Assign(Assign), labeledSet, Tree(Branch,Leaf))

import qualified Math.SetCover.EnumMap as EnumMapX
import qualified Data.EnumMap as EnumMap; import Data.EnumMap (EnumMap)
import qualified Data.Foldable as Fold
import Data.EnumSet (EnumSet)
import Data.Tuple.HT (mapSnd)


data State queue label set =
   State {
      forall queue label set.
State queue label set -> EnumMap SetId (Assign label set)
availableSubsets :: EnumMap SetId (Assign label set),
      forall queue label set. State queue label set -> queue
queue :: queue,
      forall queue label set. State queue label set -> [label]
usedSubsets :: [label]
   }

initState ::
   Methods queue set -> [Assign label set] -> State queue label set
initState :: forall queue set label.
Methods queue set -> [Assign label set] -> State queue label set
initState Methods queue set
dict [Assign label set]
subsets =
   let numberedSets :: EnumMap SetId (Assign label set)
numberedSets = [(SetId, Assign label set)] -> EnumMap SetId (Assign label set)
forall k a. Enum k => [(k, a)] -> EnumMap k a
EnumMap.fromList ([(SetId, Assign label set)] -> EnumMap SetId (Assign label set))
-> [(SetId, Assign label set)] -> EnumMap SetId (Assign label set)
forall a b. (a -> b) -> a -> b
$ [SetId] -> [Assign label set] -> [(SetId, Assign label set)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> SetId
SetId Int
0 ..] [Assign label set]
subsets
   in  State {
         availableSubsets :: EnumMap SetId (Assign label set)
availableSubsets = EnumMap SetId (Assign label set)
numberedSets,
         queue :: queue
queue = Methods queue set -> EnumMap SetId set -> queue
forall queue set. Methods queue set -> EnumMap SetId set -> queue
Queue.fromEnumMap Methods queue set
dict (EnumMap SetId set -> queue) -> EnumMap SetId set -> queue
forall a b. (a -> b) -> a -> b
$ (Assign label set -> set)
-> EnumMap SetId (Assign label set) -> EnumMap SetId set
forall a b. (a -> b) -> EnumMap SetId a -> EnumMap SetId b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Assign label set -> set
forall label set. Assign label set -> set
labeledSet EnumMap SetId (Assign label set)
numberedSets,
         usedSubsets :: [label]
usedSubsets = []
       }

{-# INLINE updateState #-}
updateState ::
   Methods queue set ->
   Assign label set -> State queue label set -> State queue label set
updateState :: forall queue set label.
Methods queue set
-> Assign label set
-> State queue label set
-> State queue label set
updateState Methods queue set
dict (Assign label
attemptLabel set
attemptedSet) State queue label set
s =
   let (EnumSet SetId
attemptElems, queue
remainingQueue) =
         Methods queue set -> queue -> set -> (EnumSet SetId, queue)
forall queue set.
Methods queue set -> queue -> set -> (EnumSet SetId, queue)
Queue.partition Methods queue set
dict (State queue label set -> queue
forall queue label set. State queue label set -> queue
queue State queue label set
s) set
attemptedSet
       (EnumMap SetId (Assign label set)
removed, EnumMap SetId (Assign label set)
remaining) =
         EnumMap SetId (Assign label set)
-> EnumSet SetId
-> (EnumMap SetId (Assign label set),
    EnumMap SetId (Assign label set))
forall e a.
Enum e =>
EnumMap e a -> EnumSet e -> (EnumMap e a, EnumMap e a)
EnumMapX.partition (State queue label set -> EnumMap SetId (Assign label set)
forall queue label set.
State queue label set -> EnumMap SetId (Assign label set)
availableSubsets State queue label set
s) EnumSet SetId
attemptElems
   in  State {
         availableSubsets :: EnumMap SetId (Assign label set)
availableSubsets = EnumMap SetId (Assign label set)
remaining,
         queue :: queue
queue = Methods queue set -> queue -> EnumMap SetId set -> queue
forall queue set.
Methods queue set -> queue -> EnumMap SetId set -> queue
Queue.difference Methods queue set
dict queue
remainingQueue (EnumMap SetId set -> queue) -> EnumMap SetId set -> queue
forall a b. (a -> b) -> a -> b
$ (Assign label set -> set)
-> EnumMap SetId (Assign label set) -> EnumMap SetId set
forall a b. (a -> b) -> EnumMap SetId a -> EnumMap SetId b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Assign label set -> set
forall label set. Assign label set -> set
labeledSet EnumMap SetId (Assign label set)
removed,
         usedSubsets :: [label]
usedSubsets = label
attemptLabel label -> [label] -> [label]
forall a. a -> [a] -> [a]
: State queue label set -> [label]
forall queue label set. State queue label set -> [label]
usedSubsets State queue label set
s
       }

{-# INLINE nextStates #-}
nextStates ::
   Methods queue set ->
   State queue label set ->
   EnumSet SetId -> [State queue label set]
nextStates :: forall queue set label.
Methods queue set
-> State queue label set
-> EnumSet SetId
-> [State queue label set]
nextStates Methods queue set
dict State queue label set
s =
   (Assign label set -> State queue label set)
-> [Assign label set] -> [State queue label set]
forall a b. (a -> b) -> [a] -> [b]
map ((Assign label set
 -> State queue label set -> State queue label set)
-> State queue label set
-> Assign label set
-> State queue label set
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Methods queue set
-> Assign label set
-> State queue label set
-> State queue label set
forall queue set label.
Methods queue set
-> Assign label set
-> State queue label set
-> State queue label set
updateState Methods queue set
dict) State queue label set
s) ([Assign label set] -> [State queue label set])
-> (EnumSet SetId -> [Assign label set])
-> EnumSet SetId
-> [State queue label set]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap SetId (Assign label set) -> [Assign label set]
forall k a. EnumMap k a -> [a]
EnumMap.elems (EnumMap SetId (Assign label set) -> [Assign label set])
-> (EnumSet SetId -> EnumMap SetId (Assign label set))
-> EnumSet SetId
-> [Assign label set]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   EnumMap SetId (Assign label set)
-> EnumSet SetId -> EnumMap SetId (Assign label set)
forall e a. Enum e => EnumMap e a -> EnumSet e -> EnumMap e a
EnumMapX.intersection (State queue label set -> EnumMap SetId (Assign label set)
forall queue label set.
State queue label set -> EnumMap SetId (Assign label set)
availableSubsets State queue label set
s)

{-# INLINE step #-}
step :: Methods queue set -> State queue label set -> [State queue label set]
step :: forall queue set label.
Methods queue set
-> State queue label set -> [State queue label set]
step Methods queue set
dict State queue label set
s =
   ((EnumSet SetId -> [State queue label set])
 -> Maybe (EnumSet SetId) -> [State queue label set])
-> Maybe (EnumSet SetId)
-> (EnumSet SetId -> [State queue label set])
-> [State queue label set]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (EnumSet SetId -> [State queue label set])
-> Maybe (EnumSet SetId) -> [State queue label set]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Fold.foldMap (Methods queue set -> queue -> Maybe (EnumSet SetId)
forall queue set.
Methods queue set -> queue -> Maybe (EnumSet SetId)
Queue.findMin Methods queue set
dict (State queue label set -> queue
forall queue label set. State queue label set -> queue
queue State queue label set
s)) ((EnumSet SetId -> [State queue label set])
 -> [State queue label set])
-> (EnumSet SetId -> [State queue label set])
-> [State queue label set]
forall a b. (a -> b) -> a -> b
$ Methods queue set
-> State queue label set
-> EnumSet SetId
-> [State queue label set]
forall queue set label.
Methods queue set
-> State queue label set
-> EnumSet SetId
-> [State queue label set]
nextStates Methods queue set
dict State queue label set
s

{-# INLINE search #-}
search :: Methods queue set -> State queue label set -> [[label]]
search :: forall queue set label.
Methods queue set -> State queue label set -> [[label]]
search Methods queue set
dict =
   let go :: State queue label set -> [[label]]
go State queue label set
s =
         case Methods queue set -> queue -> Maybe (EnumSet SetId)
forall queue set.
Methods queue set -> queue -> Maybe (EnumSet SetId)
Queue.findMin Methods queue set
dict (State queue label set -> queue
forall queue label set. State queue label set -> queue
queue State queue label set
s) of
            Maybe (EnumSet SetId)
Nothing -> [State queue label set -> [label]
forall queue label set. State queue label set -> [label]
usedSubsets State queue label set
s]
            Just EnumSet SetId
setIds -> Methods queue set
-> State queue label set
-> EnumSet SetId
-> [State queue label set]
forall queue set label.
Methods queue set
-> State queue label set
-> EnumSet SetId
-> [State queue label set]
nextStates Methods queue set
dict State queue label set
s EnumSet SetId
setIds [State queue label set]
-> (State queue label set -> [[label]]) -> [[label]]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= State queue label set -> [[label]]
go
   in  State queue label set -> [[label]]
forall {label}. State queue label set -> [[label]]
go

{-# INLINE partitions #-}
partitions :: Methods queue set -> [Assign label set] -> [[label]]
partitions :: forall queue set label.
Methods queue set -> [Assign label set] -> [[label]]
partitions Methods queue set
dict = Methods queue set -> State queue label set -> [[label]]
forall queue set label.
Methods queue set -> State queue label set -> [[label]]
search Methods queue set
dict (State queue label set -> [[label]])
-> ([Assign label set] -> State queue label set)
-> [Assign label set]
-> [[label]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Methods queue set -> [Assign label set] -> State queue label set
forall queue set label.
Methods queue set -> [Assign label set] -> State queue label set
initState Methods queue set
dict



completeTree :: Methods queue set -> State queue label set -> Tree label set
completeTree :: forall queue set label.
Methods queue set -> State queue label set -> Tree label set
completeTree Methods queue set
dict =
   let go :: State queue label set -> Tree label set
go State queue label set
s =
         case Methods queue set -> queue -> Maybe (set, EnumSet SetId)
forall queue set.
Methods queue set -> queue -> Maybe (set, EnumSet SetId)
Queue.findMinValue Methods queue set
dict (State queue label set -> queue
forall queue label set. State queue label set -> queue
queue State queue label set
s) of
            Maybe (set, EnumSet SetId)
Nothing -> Tree label set
forall label set. Tree label set
Leaf
            Just (set, EnumSet SetId)
mins ->
               (set -> [(label, Tree label set)] -> Tree label set)
-> (set, [(label, Tree label set)]) -> Tree label set
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry set -> [(label, Tree label set)] -> Tree label set
forall label set.
set -> [(label, Tree label set)] -> Tree label set
Branch ((set, [(label, Tree label set)]) -> Tree label set)
-> (set, [(label, Tree label set)]) -> Tree label set
forall a b. (a -> b) -> a -> b
$ ((EnumSet SetId -> [(label, Tree label set)])
 -> (set, EnumSet SetId) -> (set, [(label, Tree label set)]))
-> (set, EnumSet SetId)
-> (EnumSet SetId -> [(label, Tree label set)])
-> (set, [(label, Tree label set)])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (EnumSet SetId -> [(label, Tree label set)])
-> (set, EnumSet SetId) -> (set, [(label, Tree label set)])
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (set, EnumSet SetId)
mins ((EnumSet SetId -> [(label, Tree label set)])
 -> (set, [(label, Tree label set)]))
-> (EnumSet SetId -> [(label, Tree label set)])
-> (set, [(label, Tree label set)])
forall a b. (a -> b) -> a -> b
$
                  (Assign label set -> (label, Tree label set))
-> [Assign label set] -> [(label, Tree label set)]
forall a b. (a -> b) -> [a] -> [b]
map (\Assign label set
asn -> (Assign label set -> label
forall label set. Assign label set -> label
ESC.label Assign label set
asn, State queue label set -> Tree label set
go (State queue label set -> Tree label set)
-> State queue label set -> Tree label set
forall a b. (a -> b) -> a -> b
$ Methods queue set
-> Assign label set
-> State queue label set
-> State queue label set
forall queue set label.
Methods queue set
-> Assign label set
-> State queue label set
-> State queue label set
updateState Methods queue set
dict Assign label set
asn State queue label set
s)) ([Assign label set] -> [(label, Tree label set)])
-> (EnumSet SetId -> [Assign label set])
-> EnumSet SetId
-> [(label, Tree label set)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  EnumMap SetId (Assign label set) -> [Assign label set]
forall k a. EnumMap k a -> [a]
EnumMap.elems (EnumMap SetId (Assign label set) -> [Assign label set])
-> (EnumSet SetId -> EnumMap SetId (Assign label set))
-> EnumSet SetId
-> [Assign label set]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap SetId (Assign label set)
-> EnumSet SetId -> EnumMap SetId (Assign label set)
forall e a. Enum e => EnumMap e a -> EnumSet e -> EnumMap e a
EnumMapX.intersection (State queue label set -> EnumMap SetId (Assign label set)
forall queue label set.
State queue label set -> EnumMap SetId (Assign label set)
availableSubsets State queue label set
s)
   in  State queue label set -> Tree label set
forall {label}. State queue label set -> Tree label set
go

decisionTree :: Methods queue set -> [Assign label set] -> Tree label set
decisionTree :: forall queue set label.
Methods queue set -> [Assign label set] -> Tree label set
decisionTree Methods queue set
dict = Methods queue set -> State queue label set -> Tree label set
forall queue set label.
Methods queue set -> State queue label set -> Tree label set
completeTree Methods queue set
dict (State queue label set -> Tree label set)
-> ([Assign label set] -> State queue label set)
-> [Assign label set]
-> Tree label set
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Methods queue set -> [Assign label set] -> State queue label set
forall queue set label.
Methods queue set -> [Assign label set] -> State queue label set
initState Methods queue set
dict


-- * different priority queue implementations

queueMap :: Ord a => Queue.Methods queue set -> QueueMap.Methods a queue set
queueMap :: forall a queue set.
Ord a =>
Methods queue set -> Methods a queue set
queueMap = Methods queue set -> Methods a queue set
forall a queue set.
Ord a =>
Methods queue set -> Methods a queue set
QueueMap.methods

queueSet :: Ord a => QueueSet.Methods a
queueSet :: forall a. Ord a => Methods a
queueSet = Methods a
forall a. Ord a => Methods a
QueueSet.methods

queueBit :: BitPos.C bits => QueueBit.Methods bits
queueBit :: forall bits. C bits => Methods bits
queueBit = Methods bits
forall bits. C bits => Methods bits
QueueBit.methods

queueIntSet :: QueueBit.MethodsIntSet
queueIntSet :: MethodsIntSet
queueIntSet = MethodsIntSet
QueueBit.methodsIntSet

queueBitPQ :: BitPos.C bits => QueueBitPQ.Methods bits
queueBitPQ :: forall bits. C bits => Methods bits
queueBitPQ = Methods bits
forall bits. C bits => Methods bits
QueueBitPQ.methods