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)
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)