module Math.SetCover.BitPriorityQueue (
   Queue,
   null,
   fromSets,
   elemUnions,
   partition,
   difference,
   findMin,
   findMinValue,
   ) where

import qualified Math.SetCover.EnumMap as EnumMapX
import qualified Math.SetCover.BitPosition as BitPos
import qualified Math.SetCover.BitMap as BitMap
import qualified Math.SetCover.BitSet as BitSet
import Math.SetCover.EnumMap (constIntMapFromBits)

import qualified Data.EnumSet as EnumSet; import Data.EnumSet (EnumSet)
import qualified Data.IntMap as IntMap; import Data.IntMap (IntMap)
import qualified Data.Foldable as Fold
import Data.EnumMap (EnumMap)
import Data.Monoid (mempty, mconcat)
import Data.Maybe.HT (toMaybe)

import Prelude hiding (null)


{-
We could generalize @EnumSet e@ to @a@
and pretend that the priorities are independent of the 'EnumSet' sizes.
However, 'difference' makes only sense if the priorities match the set sizes.
-}
data Queue bits e = Queue (BitMap.Map bits) (IntMap (EnumSet e))

null :: Queue bits e -> Bool
null :: forall bits e. Queue bits e -> Bool
null (Queue Map bits
_ns IntMap (EnumSet e)
m) = IntMap (EnumSet e) -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap (EnumSet e)
m

fromSets ::
   (Enum e, BitPos.C bits) => EnumMap e (BitSet.Set bits) -> Queue bits e
fromSets :: forall e bits.
(Enum e, C bits) =>
EnumMap e (Set bits) -> Queue bits e
fromSets EnumMap e (Set bits)
xs =
   Map bits -> IntMap (EnumSet e) -> Queue bits e
forall bits e. Map bits -> IntMap (EnumSet e) -> Queue bits e
Queue
      ((Map bits -> Set bits -> Map bits)
-> Map bits -> EnumMap e (Set bits) -> Map bits
forall b a. (b -> a -> b) -> b -> EnumMap e a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Fold.foldl' ((Set bits -> Map bits -> Map bits)
-> Map bits -> Set bits -> Map bits
forall a b c. (a -> b -> c) -> b -> a -> c
flip Set bits -> Map bits -> Map bits
forall bits. C bits => Set bits -> Map bits -> Map bits
BitMap.inc) Map bits
forall a. Monoid a => a
mempty EnumMap e (Set bits)
xs)
      (EnumMap e (Set bits) -> IntMap (EnumSet e)
forall bits e.
(C bits, Enum e) =>
EnumMap e (Set bits) -> IntMap (EnumSet e)
EnumMapX.transposeBitSet EnumMap e (Set bits)
xs)

elemUnions :: (Enum e) => Queue t e -> EnumSet e
elemUnions :: forall e t. Enum e => Queue t e -> EnumSet e
elemUnions (Queue Map t
_ns IntMap (EnumSet e)
m) = IntMap (EnumSet e) -> EnumSet e
forall m. Monoid m => IntMap m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Fold.fold IntMap (EnumSet e)
m

keysBits :: (BitPos.C bits) => Queue bits e -> BitSet.Set bits
keysBits :: forall bits e. C bits => Queue bits e -> Set bits
keysBits (Queue Map bits
_ IntMap (EnumSet e)
m) =
   [Set bits] -> Set bits
forall a. Monoid a => [a] -> a
mconcat ([Set bits] -> Set bits) -> [Set bits] -> Set bits
forall a b. (a -> b) -> a -> b
$ (Key -> Set bits) -> [Key] -> [Set bits]
forall a b. (a -> b) -> [a] -> [b]
map Key -> Set bits
forall bits. C bits => Key -> Set bits
BitPos.singleton ([Key] -> [Set bits]) -> [Key] -> [Set bits]
forall a b. (a -> b) -> a -> b
$ IntMap (EnumSet e) -> [Key]
forall a. IntMap a -> [Key]
IntMap.keys IntMap (EnumSet e)
m

findMin :: (BitPos.C bits) => Queue bits e -> Maybe (EnumSet e)
findMin :: forall bits e. C bits => Queue bits e -> Maybe (EnumSet e)
findMin = ((Set bits, EnumSet e) -> EnumSet e)
-> Maybe (Set bits, EnumSet e) -> Maybe (EnumSet e)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set bits, EnumSet e) -> EnumSet e
forall a b. (a, b) -> b
snd (Maybe (Set bits, EnumSet e) -> Maybe (EnumSet e))
-> (Queue bits e -> Maybe (Set bits, EnumSet e))
-> Queue bits e
-> Maybe (EnumSet e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Queue bits e -> Maybe (Set bits, EnumSet e)
forall bits e.
C bits =>
Queue bits e -> Maybe (Set bits, EnumSet e)
findMinValue

findMinValue ::
   (BitPos.C bits) => Queue bits e -> Maybe (BitSet.Set bits, EnumSet e)
findMinValue :: forall bits e.
C bits =>
Queue bits e -> Maybe (Set bits, EnumSet e)
findMinValue q :: Queue bits e
q@(Queue Map bits
ns IntMap (EnumSet e)
m) =
   let used :: Set bits
used = Queue bits e -> Set bits
forall bits e. C bits => Queue bits e -> Set bits
keysBits Queue bits e
q
       minSet :: Set bits
minSet = Set bits -> Set bits
forall bits. C bits => Set bits -> Set bits
BitSet.keepMinimum (Set bits -> Set bits) -> Set bits -> Set bits
forall a b. (a -> b) -> a -> b
$ Set bits -> Map bits -> Set bits
forall bits. C bits => Set bits -> Map bits -> Set bits
BitMap.minimumSet Set bits
used Map bits
ns
   in  Bool -> (Set bits, EnumSet e) -> Maybe (Set bits, EnumSet e)
forall a. Bool -> a -> Maybe a
toMaybe (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set bits -> Bool
forall bits. C bits => Set bits -> Bool
BitSet.null Set bits
used) ((Set bits, EnumSet e) -> Maybe (Set bits, EnumSet e))
-> (Set bits, EnumSet e) -> Maybe (Set bits, EnumSet e)
forall a b. (a -> b) -> a -> b
$ (,) Set bits
minSet (EnumSet e -> (Set bits, EnumSet e))
-> EnumSet e -> (Set bits, EnumSet e)
forall a b. (a -> b) -> a -> b
$
          EnumSet e -> Key -> IntMap (EnumSet e) -> EnumSet e
forall a. a -> Key -> IntMap a -> a
IntMap.findWithDefault
             ([Char] -> EnumSet e
forall a. HasCallStack => [Char] -> a
error [Char]
"findMin: key with minimal priority must be in IntMap")
             (Set bits -> Key
forall bits. C bits => Set bits -> Key
BitPos.bitPosition Set bits
minSet)
             IntMap (EnumSet e)
m

difference ::
   (BitPos.C bits, Enum e) => Queue bits e -> Queue bits e -> Queue bits e
difference :: forall bits e.
(C bits, Enum e) =>
Queue bits e -> Queue bits e -> Queue bits e
difference q0 :: Queue bits e
q0@(Queue Map bits
ns0 IntMap (EnumSet e)
m0) (Queue Map bits
ns1 IntMap (EnumSet e)
m1) =
   Map bits -> IntMap (EnumSet e) -> Queue bits e
forall bits e. Map bits -> IntMap (EnumSet e) -> Queue bits e
Queue
      (Map bits -> Map bits -> Map bits
forall bits. C bits => Map bits -> Map bits -> Map bits
BitMap.sub Map bits
ns0 (Map bits -> Map bits) -> Map bits -> Map bits
forall a b. (a -> b) -> a -> b
$ Map bits -> Set bits -> Map bits
forall bits. C bits => Map bits -> Set bits -> Map bits
BitMap.intersectionSet Map bits
ns1 (Set bits -> Map bits) -> Set bits -> Map bits
forall a b. (a -> b) -> a -> b
$ Queue bits e -> Set bits
forall bits e. C bits => Queue bits e -> Set bits
keysBits Queue bits e
q0)
      ((EnumSet e -> EnumSet e -> Maybe (EnumSet e))
-> IntMap (EnumSet e) -> IntMap (EnumSet e) -> IntMap (EnumSet e)
forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
IntMap.differenceWith ((EnumSet e -> Maybe (EnumSet e)
forall a. a -> Maybe a
Just(EnumSet e -> Maybe (EnumSet e))
-> (EnumSet e -> EnumSet e) -> EnumSet e -> Maybe (EnumSet e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((EnumSet e -> EnumSet e) -> EnumSet e -> Maybe (EnumSet e))
-> (EnumSet e -> EnumSet e -> EnumSet e)
-> EnumSet e
-> EnumSet e
-> Maybe (EnumSet e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumSet e -> EnumSet e -> EnumSet e
forall k. EnumSet k -> EnumSet k -> EnumSet k
EnumSet.difference) IntMap (EnumSet e)
m0 IntMap (EnumSet e)
m1)

partition ::
   (BitPos.C bits, Enum e) =>
   Queue bits e -> BitSet.Set bits -> (Queue bits e, Queue bits e)
partition :: forall bits e.
(C bits, Enum e) =>
Queue bits e -> Set bits -> (Queue bits e, Queue bits e)
partition (Queue Map bits
ns IntMap (EnumSet e)
m) Set bits
s =
   let section :: IntMap (EnumSet e)
section = IntMap (EnumSet e) -> IntMap () -> IntMap (EnumSet e)
forall a b. IntMap a -> IntMap b -> IntMap a
IntMap.intersection IntMap (EnumSet e)
m (IntMap () -> IntMap (EnumSet e))
-> IntMap () -> IntMap (EnumSet e)
forall a b. (a -> b) -> a -> b
$ () -> Set bits -> IntMap ()
forall bits b. C bits => b -> Set bits -> IntMap b
constIntMapFromBits () Set bits
s
   in  (Map bits -> IntMap (EnumSet e) -> Queue bits e
forall bits e. Map bits -> IntMap (EnumSet e) -> Queue bits e
Queue (Map bits -> Set bits -> Map bits
forall bits. C bits => Map bits -> Set bits -> Map bits
BitMap.intersectionSet Map bits
ns Set bits
s) IntMap (EnumSet e)
section,
        Map bits -> IntMap (EnumSet e) -> Queue bits e
forall bits e. Map bits -> IntMap (EnumSet e) -> Queue bits e
Queue (Map bits -> Set bits -> Map bits
forall bits. C bits => Map bits -> Set bits -> Map bits
BitMap.differenceSet Map bits
ns Set bits
s) (IntMap (EnumSet e) -> Queue bits e)
-> IntMap (EnumSet e) -> Queue bits e
forall a b. (a -> b) -> a -> b
$ IntMap (EnumSet e) -> IntMap (EnumSet e) -> IntMap (EnumSet e)
forall a b. IntMap a -> IntMap b -> IntMap a
IntMap.difference IntMap (EnumSet e)
m IntMap (EnumSet e)
section)