{- |
Alternative to "Math.SetCover.Queue.Set"
that represents sets by bit masks and uses the faster Int priority queue.
-}
module Math.SetCover.Queue.Bit (
   Methods, methods,
   MethodsIntSet, methodsIntSet,
   ) where

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

import qualified Math.SetCover.EnumMap as EnumMapX
import qualified Math.SetCover.BitPosition as BitPos
import qualified Math.SetCover.BitSet as BitSet

import qualified Data.IntPSQ as PSQ
import qualified Data.EnumSet as EnumSet; import Data.EnumSet (EnumSet)
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.List as List
import Data.IntSet (IntSet)
import Data.Tuple.HT (swap, mapFst)


type
   Methods bits =
      Queue.Methods (PSQ.IntPSQ Int (EnumSet SetId)) (BitSet.Set bits)

methods :: BitPos.C bits => Methods bits
methods :: forall bits. C bits => Methods bits
methods =
   Queue.Methods {
      fromEnumMap :: EnumMap SetId (Set bits) -> IntPSQ Int (EnumSet SetId)
Queue.fromEnumMap =
         [(Int, Int, EnumSet SetId)] -> IntPSQ Int (EnumSet SetId)
forall p v. Ord p => [(Int, p, v)] -> IntPSQ p v
PSQ.fromList ([(Int, Int, EnumSet SetId)] -> IntPSQ Int (EnumSet SetId))
-> (EnumMap SetId (Set bits) -> [(Int, Int, EnumSet SetId)])
-> EnumMap SetId (Set bits)
-> IntPSQ Int (EnumSet SetId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, EnumSet SetId) -> (Int, Int, EnumSet SetId))
-> [(Int, EnumSet SetId)] -> [(Int, Int, EnumSet SetId)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
elm, EnumSet SetId
ns) -> (Int
elm, EnumSet SetId -> Int
forall k. EnumSet k -> Int
EnumSet.size EnumSet SetId
ns, EnumSet SetId
ns)) ([(Int, EnumSet SetId)] -> [(Int, Int, EnumSet SetId)])
-> (EnumMap SetId (Set bits) -> [(Int, EnumSet SetId)])
-> EnumMap SetId (Set bits)
-> [(Int, Int, EnumSet SetId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         IntMap (EnumSet SetId) -> [(Int, EnumSet SetId)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList (IntMap (EnumSet SetId) -> [(Int, EnumSet SetId)])
-> (EnumMap SetId (Set bits) -> IntMap (EnumSet SetId))
-> EnumMap SetId (Set bits)
-> [(Int, EnumSet SetId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap SetId (Set bits) -> IntMap (EnumSet SetId)
forall bits e.
(C bits, Enum e) =>
EnumMap e (Set bits) -> IntMap (EnumSet e)
EnumMapX.transposeBitSet,
      partition :: IntPSQ Int (EnumSet SetId)
-> Set bits -> (EnumSet SetId, IntPSQ Int (EnumSet SetId))
Queue.partition =
         \IntPSQ Int (EnumSet SetId)
q -> ([EnumSet SetId] -> EnumSet SetId)
-> ([EnumSet SetId], IntPSQ Int (EnumSet SetId))
-> (EnumSet SetId, IntPSQ Int (EnumSet SetId))
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst [EnumSet SetId] -> EnumSet SetId
forall k. [EnumSet k] -> EnumSet k
EnumSet.unions (([EnumSet SetId], IntPSQ Int (EnumSet SetId))
 -> (EnumSet SetId, IntPSQ Int (EnumSet SetId)))
-> (Set bits -> ([EnumSet SetId], IntPSQ Int (EnumSet SetId)))
-> Set bits
-> (EnumSet SetId, IntPSQ Int (EnumSet SetId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntPSQ Int (EnumSet SetId)
-> [Int] -> ([EnumSet SetId], IntPSQ Int (EnumSet SetId))
forall p v. Ord p => IntPSQ p v -> [Int] -> ([v], IntPSQ p v)
partitionPSQ IntPSQ Int (EnumSet SetId)
q ([Int] -> ([EnumSet SetId], IntPSQ Int (EnumSet SetId)))
-> (Set bits -> [Int])
-> Set bits
-> ([EnumSet SetId], IntPSQ Int (EnumSet SetId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set bits -> [Int]
forall bits. C bits => Set bits -> [Int]
BitPos.unpack,
      difference :: IntPSQ Int (EnumSet SetId)
-> EnumMap SetId (Set bits) -> IntPSQ Int (EnumSet SetId)
Queue.difference = \IntPSQ Int (EnumSet SetId)
q ->
         (IntPSQ Int (EnumSet SetId)
 -> (Int, EnumSet SetId) -> IntPSQ Int (EnumSet SetId))
-> IntPSQ Int (EnumSet SetId)
-> [(Int, EnumSet SetId)]
-> IntPSQ Int (EnumSet SetId)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Int, EnumSet SetId)
 -> IntPSQ Int (EnumSet SetId) -> IntPSQ Int (EnumSet SetId))
-> IntPSQ Int (EnumSet SetId)
-> (Int, EnumSet SetId)
-> IntPSQ Int (EnumSet SetId)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int, EnumSet SetId)
-> IntPSQ Int (EnumSet SetId) -> IntPSQ Int (EnumSet SetId)
forall e.
(Int, EnumSet e)
-> IntPSQ Int (EnumSet e) -> IntPSQ Int (EnumSet e)
deleteSetFromPSQ) IntPSQ Int (EnumSet SetId)
q ([(Int, EnumSet SetId)] -> IntPSQ Int (EnumSet SetId))
-> (EnumMap SetId (Set bits) -> [(Int, EnumSet SetId)])
-> EnumMap SetId (Set bits)
-> IntPSQ Int (EnumSet SetId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         IntMap (EnumSet SetId) -> [(Int, EnumSet SetId)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList (IntMap (EnumSet SetId) -> [(Int, EnumSet SetId)])
-> (EnumMap SetId (Set bits) -> IntMap (EnumSet SetId))
-> EnumMap SetId (Set bits)
-> [(Int, EnumSet SetId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap SetId (Set bits) -> IntMap (EnumSet SetId)
forall bits e.
(C bits, Enum e) =>
EnumMap e (Set bits) -> IntMap (EnumSet e)
EnumMapX.transposeBitSet,
      findMinValue :: IntPSQ Int (EnumSet SetId) -> Maybe (Set bits, EnumSet SetId)
Queue.findMinValue =
         ((Int, Int, EnumSet SetId) -> (Set bits, EnumSet SetId))
-> Maybe (Int, Int, EnumSet SetId)
-> Maybe (Set bits, EnumSet SetId)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
elm, Int
_, EnumSet SetId
ns) -> (Int -> Set bits
forall bits. C bits => Int -> Set bits
BitPos.singleton Int
elm, EnumSet SetId
ns)) (Maybe (Int, Int, EnumSet SetId)
 -> Maybe (Set bits, EnumSet SetId))
-> (IntPSQ Int (EnumSet SetId) -> Maybe (Int, Int, EnumSet SetId))
-> IntPSQ Int (EnumSet SetId)
-> Maybe (Set bits, EnumSet SetId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntPSQ Int (EnumSet SetId) -> Maybe (Int, Int, EnumSet SetId)
forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v)
PSQ.findMin,
      null :: IntPSQ Int (EnumSet SetId) -> Bool
Queue.null = IntPSQ Int (EnumSet SetId) -> Bool
forall p v. IntPSQ p v -> Bool
PSQ.null
   }


type MethodsIntSet = Queue.Methods (PSQ.IntPSQ Int (EnumSet SetId)) IntSet

methodsIntSet :: MethodsIntSet
methodsIntSet :: MethodsIntSet
methodsIntSet =
   Queue.Methods {
      fromEnumMap :: EnumMap SetId IntSet -> IntPSQ Int (EnumSet SetId)
Queue.fromEnumMap =
         [(Int, Int, EnumSet SetId)] -> IntPSQ Int (EnumSet SetId)
forall p v. Ord p => [(Int, p, v)] -> IntPSQ p v
PSQ.fromList ([(Int, Int, EnumSet SetId)] -> IntPSQ Int (EnumSet SetId))
-> (EnumMap SetId IntSet -> [(Int, Int, EnumSet SetId)])
-> EnumMap SetId IntSet
-> IntPSQ Int (EnumSet SetId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, EnumSet SetId) -> (Int, Int, EnumSet SetId))
-> [(Int, EnumSet SetId)] -> [(Int, Int, EnumSet SetId)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
elm, EnumSet SetId
ns) -> (Int
elm, EnumSet SetId -> Int
forall k. EnumSet k -> Int
EnumSet.size EnumSet SetId
ns, EnumSet SetId
ns)) ([(Int, EnumSet SetId)] -> [(Int, Int, EnumSet SetId)])
-> (EnumMap SetId IntSet -> [(Int, EnumSet SetId)])
-> EnumMap SetId IntSet
-> [(Int, Int, EnumSet SetId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         IntMap (EnumSet SetId) -> [(Int, EnumSet SetId)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList (IntMap (EnumSet SetId) -> [(Int, EnumSet SetId)])
-> (EnumMap SetId IntSet -> IntMap (EnumSet SetId))
-> EnumMap SetId IntSet
-> [(Int, EnumSet SetId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap SetId IntSet -> IntMap (EnumSet SetId)
forall e. Enum e => EnumMap e IntSet -> IntMap (EnumSet e)
EnumMapX.transposeIntSet,
      partition :: IntPSQ Int (EnumSet SetId)
-> IntSet -> (EnumSet SetId, IntPSQ Int (EnumSet SetId))
Queue.partition =
         \IntPSQ Int (EnumSet SetId)
q -> ([EnumSet SetId] -> EnumSet SetId)
-> ([EnumSet SetId], IntPSQ Int (EnumSet SetId))
-> (EnumSet SetId, IntPSQ Int (EnumSet SetId))
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst [EnumSet SetId] -> EnumSet SetId
forall k. [EnumSet k] -> EnumSet k
EnumSet.unions (([EnumSet SetId], IntPSQ Int (EnumSet SetId))
 -> (EnumSet SetId, IntPSQ Int (EnumSet SetId)))
-> (IntSet -> ([EnumSet SetId], IntPSQ Int (EnumSet SetId)))
-> IntSet
-> (EnumSet SetId, IntPSQ Int (EnumSet SetId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntPSQ Int (EnumSet SetId)
-> [Int] -> ([EnumSet SetId], IntPSQ Int (EnumSet SetId))
forall p v. Ord p => IntPSQ p v -> [Int] -> ([v], IntPSQ p v)
partitionPSQ IntPSQ Int (EnumSet SetId)
q ([Int] -> ([EnumSet SetId], IntPSQ Int (EnumSet SetId)))
-> (IntSet -> [Int])
-> IntSet
-> ([EnumSet SetId], IntPSQ Int (EnumSet SetId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IntSet.toList,
      difference :: IntPSQ Int (EnumSet SetId)
-> EnumMap SetId IntSet -> IntPSQ Int (EnumSet SetId)
Queue.difference = \IntPSQ Int (EnumSet SetId)
q ->
         (IntPSQ Int (EnumSet SetId)
 -> (Int, EnumSet SetId) -> IntPSQ Int (EnumSet SetId))
-> IntPSQ Int (EnumSet SetId)
-> [(Int, EnumSet SetId)]
-> IntPSQ Int (EnumSet SetId)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Int, EnumSet SetId)
 -> IntPSQ Int (EnumSet SetId) -> IntPSQ Int (EnumSet SetId))
-> IntPSQ Int (EnumSet SetId)
-> (Int, EnumSet SetId)
-> IntPSQ Int (EnumSet SetId)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int, EnumSet SetId)
-> IntPSQ Int (EnumSet SetId) -> IntPSQ Int (EnumSet SetId)
forall e.
(Int, EnumSet e)
-> IntPSQ Int (EnumSet e) -> IntPSQ Int (EnumSet e)
deleteSetFromPSQ) IntPSQ Int (EnumSet SetId)
q ([(Int, EnumSet SetId)] -> IntPSQ Int (EnumSet SetId))
-> (EnumMap SetId IntSet -> [(Int, EnumSet SetId)])
-> EnumMap SetId IntSet
-> IntPSQ Int (EnumSet SetId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         IntMap (EnumSet SetId) -> [(Int, EnumSet SetId)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList (IntMap (EnumSet SetId) -> [(Int, EnumSet SetId)])
-> (EnumMap SetId IntSet -> IntMap (EnumSet SetId))
-> EnumMap SetId IntSet
-> [(Int, EnumSet SetId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap SetId IntSet -> IntMap (EnumSet SetId)
forall e. Enum e => EnumMap e IntSet -> IntMap (EnumSet e)
EnumMapX.transposeIntSet,
      findMinValue :: IntPSQ Int (EnumSet SetId) -> Maybe (IntSet, EnumSet SetId)
Queue.findMinValue =
         ((Int, Int, EnumSet SetId) -> (IntSet, EnumSet SetId))
-> Maybe (Int, Int, EnumSet SetId) -> Maybe (IntSet, EnumSet SetId)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
elm, Int
_, EnumSet SetId
ns) -> (Int -> IntSet
IntSet.singleton Int
elm, EnumSet SetId
ns)) (Maybe (Int, Int, EnumSet SetId) -> Maybe (IntSet, EnumSet SetId))
-> (IntPSQ Int (EnumSet SetId) -> Maybe (Int, Int, EnumSet SetId))
-> IntPSQ Int (EnumSet SetId)
-> Maybe (IntSet, EnumSet SetId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntPSQ Int (EnumSet SetId) -> Maybe (Int, Int, EnumSet SetId)
forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v)
PSQ.findMin,
      null :: IntPSQ Int (EnumSet SetId) -> Bool
Queue.null = IntPSQ Int (EnumSet SetId) -> Bool
forall p v. IntPSQ p v -> Bool
PSQ.null
   }


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

deleteSetFromPSQ ::
   (Int, EnumSet e) -> PSQ.IntPSQ Int (EnumSet e) ->
   PSQ.IntPSQ Int (EnumSet e)
deleteSetFromPSQ :: forall e.
(Int, EnumSet e)
-> IntPSQ Int (EnumSet e) -> IntPSQ Int (EnumSet e)
deleteSetFromPSQ (Int
elm, EnumSet e
ns) =
   ((Int, EnumSet e) -> (Int, EnumSet e))
-> Int -> IntPSQ Int (EnumSet e) -> IntPSQ Int (EnumSet e)
forall p v.
Ord p =>
((p, v) -> (p, v)) -> Int -> IntPSQ p v -> IntPSQ p v
updatePSQ (((Int, EnumSet e) -> EnumSet e -> (Int, EnumSet e))
-> EnumSet e -> (Int, EnumSet e) -> (Int, EnumSet e)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int, EnumSet e) -> EnumSet e -> (Int, EnumSet e)
forall e. (Int, EnumSet e) -> EnumSet e -> (Int, EnumSet e)
differenceSizedSet EnumSet e
ns) Int
elm

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

updatePSQ ::
   (Ord p) => ((p, v) -> (p, v)) -> Int -> PSQ.IntPSQ p v -> PSQ.IntPSQ p v
updatePSQ :: forall p v.
Ord p =>
((p, v) -> (p, v)) -> Int -> IntPSQ p v -> IntPSQ p v
updatePSQ (p, v) -> (p, v)
f Int
k = ((), IntPSQ p v) -> IntPSQ p v
forall a b. (a, b) -> b
snd (((), IntPSQ p v) -> IntPSQ p v)
-> (IntPSQ p v -> ((), IntPSQ p v)) -> IntPSQ p v -> IntPSQ p v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (p, v) -> ((), Maybe (p, v)))
-> Int -> IntPSQ p v -> ((), IntPSQ p v)
forall p v b.
Ord p =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> Int -> IntPSQ p v -> (b, IntPSQ p v)
PSQ.alter ((,) () (Maybe (p, v) -> ((), Maybe (p, v)))
-> (Maybe (p, v) -> Maybe (p, v))
-> Maybe (p, v)
-> ((), Maybe (p, v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((p, v) -> (p, v)) -> Maybe (p, v) -> Maybe (p, v)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (p, v) -> (p, v)
f) Int
k