{- |
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.EnumMap (EnumMap)
import Data.Tuple.HT (swap, mapFst)


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

methods :: Ord a => Methods a
methods :: forall a. Ord a => Methods a
methods =
   Queue.Methods {
      fromEnumMap :: EnumMap SetId (Set a) -> OrdPSQ a Int (EnumSet SetId)
Queue.fromEnumMap =
         [(a, Int, EnumSet SetId)] -> OrdPSQ a Int (EnumSet SetId)
forall k p v. (Ord k, Ord p) => [(k, p, v)] -> OrdPSQ k p v
PSQ.fromList ([(a, Int, EnumSet SetId)] -> OrdPSQ a Int (EnumSet SetId))
-> (EnumMap SetId (Set a) -> [(a, Int, EnumSet SetId)])
-> EnumMap SetId (Set a)
-> OrdPSQ a Int (EnumSet SetId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, EnumSet SetId) -> (a, Int, EnumSet SetId))
-> [(a, EnumSet SetId)] -> [(a, Int, EnumSet SetId)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
elm, EnumSet SetId
ns) -> (a
elm, EnumSet SetId -> Int
forall k. EnumSet k -> Int
EnumSet.size EnumSet SetId
ns, EnumSet SetId
ns)) ([(a, EnumSet SetId)] -> [(a, Int, EnumSet SetId)])
-> (EnumMap SetId (Set a) -> [(a, EnumSet SetId)])
-> EnumMap SetId (Set a)
-> [(a, Int, EnumSet SetId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         Map a (EnumSet SetId) -> [(a, EnumSet SetId)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map a (EnumSet SetId) -> [(a, EnumSet SetId)])
-> (EnumMap SetId (Set a) -> Map a (EnumSet SetId))
-> EnumMap SetId (Set a)
-> [(a, EnumSet SetId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap SetId (Set a) -> Map a (EnumSet SetId)
forall e a.
(Enum e, Ord a) =>
EnumMap e (Set a) -> Map a (EnumSet e)
EnumMapX.transposeSet,
      partition :: OrdPSQ a Int (EnumSet SetId)
-> Set a -> (EnumSet SetId, OrdPSQ a Int (EnumSet SetId))
Queue.partition =
         \OrdPSQ a Int (EnumSet SetId)
q -> ([EnumSet SetId] -> EnumSet SetId)
-> ([EnumSet SetId], OrdPSQ a Int (EnumSet SetId))
-> (EnumSet SetId, OrdPSQ a 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], OrdPSQ a Int (EnumSet SetId))
 -> (EnumSet SetId, OrdPSQ a Int (EnumSet SetId)))
-> (Set a -> ([EnumSet SetId], OrdPSQ a Int (EnumSet SetId)))
-> Set a
-> (EnumSet SetId, OrdPSQ a Int (EnumSet SetId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdPSQ a Int (EnumSet SetId)
-> [a] -> ([EnumSet SetId], OrdPSQ a Int (EnumSet SetId))
forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> [k] -> ([v], OrdPSQ k p v)
partitionPSQ OrdPSQ a Int (EnumSet SetId)
q ([a] -> ([EnumSet SetId], OrdPSQ a Int (EnumSet SetId)))
-> (Set a -> [a])
-> Set a
-> ([EnumSet SetId], OrdPSQ a Int (EnumSet SetId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList,
      difference :: OrdPSQ a Int (EnumSet SetId)
-> EnumMap SetId (Set a) -> OrdPSQ a Int (EnumSet SetId)
Queue.difference = OrdPSQ a Int (EnumSet SetId)
-> EnumMap SetId (Set a) -> OrdPSQ a Int (EnumSet SetId)
forall k e.
(Ord k, Enum e) =>
OrdPSQ k Int (EnumSet e)
-> EnumMap e (Set k) -> OrdPSQ k Int (EnumSet e)
differencePSQ,
      findMinValue :: OrdPSQ a Int (EnumSet SetId) -> Maybe (Set a, EnumSet SetId)
Queue.findMinValue =
         ((a, Int, EnumSet SetId) -> (Set a, EnumSet SetId))
-> Maybe (a, Int, EnumSet SetId) -> Maybe (Set a, EnumSet SetId)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
elm, Int
_, EnumSet SetId
ns) -> (a -> Set a
forall a. a -> Set a
Set.singleton a
elm, EnumSet SetId
ns)) (Maybe (a, Int, EnumSet SetId) -> Maybe (Set a, EnumSet SetId))
-> (OrdPSQ a Int (EnumSet SetId) -> Maybe (a, Int, EnumSet SetId))
-> OrdPSQ a Int (EnumSet SetId)
-> Maybe (Set a, EnumSet SetId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdPSQ a Int (EnumSet SetId) -> Maybe (a, Int, EnumSet SetId)
forall k p v. OrdPSQ k p v -> Maybe (k, p, v)
PSQ.findMin,
      null :: OrdPSQ a Int (EnumSet SetId) -> Bool
Queue.null = OrdPSQ a Int (EnumSet SetId) -> Bool
forall k p v. OrdPSQ k p v -> Bool
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 :: forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> [k] -> ([v], OrdPSQ k p v)
partitionPSQ =
   ((OrdPSQ k p v, [v]) -> ([v], OrdPSQ k p v)
forall a b. (a, b) -> (b, a)
swap ((OrdPSQ k p v, [v]) -> ([v], OrdPSQ k p v))
-> ([k] -> (OrdPSQ k p v, [v])) -> [k] -> ([v], OrdPSQ k p v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (([k] -> (OrdPSQ k p v, [v])) -> [k] -> ([v], OrdPSQ k p v))
-> (OrdPSQ k p v -> [k] -> (OrdPSQ k p v, [v]))
-> OrdPSQ k p v
-> [k]
-> ([v], OrdPSQ k p v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (OrdPSQ k p v -> k -> (OrdPSQ k p v, v))
-> OrdPSQ k p v -> [k] -> (OrdPSQ k p v, [v])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL
      (\OrdPSQ k p v
q0 k
k ->
         (OrdPSQ k p v, v)
-> ((p, v, OrdPSQ k p v) -> (OrdPSQ k p v, v))
-> Maybe (p, v, OrdPSQ k p v)
-> (OrdPSQ k p v, v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            ([Char] -> (OrdPSQ k p v, v)
forall a. HasCallStack => [Char] -> a
error [Char]
"partitionPSQ: key not contained in queue's key set")
            (\(p
_p,v
v,OrdPSQ k p v
q1) -> (OrdPSQ k p v
q1, v
v)) (Maybe (p, v, OrdPSQ k p v) -> (OrdPSQ k p v, v))
-> Maybe (p, v, OrdPSQ k p v) -> (OrdPSQ k p v, v)
forall a b. (a -> b) -> a -> b
$
         k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
forall k p v.
(Ord k, Ord p) =>
k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
PSQ.deleteView k
k OrdPSQ k p v
q0)

differencePSQ, _differencePSQ ::
   (Ord k, Enum e) =>
   PSQ.OrdPSQ k Int (EnumSet e) ->
   EnumMap e (Set.Set k) -> PSQ.OrdPSQ k Int (EnumSet e)
differencePSQ :: forall k e.
(Ord k, Enum e) =>
OrdPSQ k Int (EnumSet e)
-> EnumMap e (Set k) -> OrdPSQ k Int (EnumSet e)
differencePSQ OrdPSQ k Int (EnumSet e)
q =
   (OrdPSQ k Int (EnumSet e)
 -> (k, EnumSet e) -> OrdPSQ k Int (EnumSet e))
-> OrdPSQ k Int (EnumSet e)
-> [(k, EnumSet e)]
-> OrdPSQ k Int (EnumSet e)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((k, EnumSet e)
 -> OrdPSQ k Int (EnumSet e) -> OrdPSQ k Int (EnumSet e))
-> OrdPSQ k Int (EnumSet e)
-> (k, EnumSet e)
-> OrdPSQ k Int (EnumSet e)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k, EnumSet e)
-> OrdPSQ k Int (EnumSet e) -> OrdPSQ k Int (EnumSet e)
forall k e.
Ord k =>
(k, EnumSet e)
-> OrdPSQ k Int (EnumSet e) -> OrdPSQ k Int (EnumSet e)
deleteSetFromPSQ) OrdPSQ k Int (EnumSet e)
q ([(k, EnumSet e)] -> OrdPSQ k Int (EnumSet e))
-> (EnumMap e (Set k) -> [(k, EnumSet e)])
-> EnumMap e (Set k)
-> OrdPSQ k Int (EnumSet e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (EnumSet e) -> [(k, EnumSet e)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map k (EnumSet e) -> [(k, EnumSet e)])
-> (EnumMap e (Set k) -> Map k (EnumSet e))
-> EnumMap e (Set k)
-> [(k, EnumSet e)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap e (Set k) -> Map k (EnumSet e)
forall e a.
(Enum e, Ord a) =>
EnumMap e (Set a) -> Map a (EnumSet e)
EnumMapX.transposeSet

_differencePSQ :: forall k e.
(Ord k, Enum e) =>
OrdPSQ k Int (EnumSet e)
-> EnumMap e (Set k) -> OrdPSQ k Int (EnumSet e)
_differencePSQ OrdPSQ k Int (EnumSet e)
q =
   (OrdPSQ k Int (EnumSet e)
 -> k -> EnumSet e -> OrdPSQ k Int (EnumSet e))
-> OrdPSQ k Int (EnumSet e)
-> Map k (EnumSet e)
-> OrdPSQ k Int (EnumSet e)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey (((k, EnumSet e) -> OrdPSQ k Int (EnumSet e))
-> k -> EnumSet e -> OrdPSQ k Int (EnumSet e)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((k, EnumSet e) -> OrdPSQ k Int (EnumSet e))
 -> k -> EnumSet e -> OrdPSQ k Int (EnumSet e))
-> (OrdPSQ k Int (EnumSet e)
    -> (k, EnumSet e) -> OrdPSQ k Int (EnumSet e))
-> OrdPSQ k Int (EnumSet e)
-> k
-> EnumSet e
-> OrdPSQ k Int (EnumSet e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, EnumSet e)
 -> OrdPSQ k Int (EnumSet e) -> OrdPSQ k Int (EnumSet e))
-> OrdPSQ k Int (EnumSet e)
-> (k, EnumSet e)
-> OrdPSQ k Int (EnumSet e)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k, EnumSet e)
-> OrdPSQ k Int (EnumSet e) -> OrdPSQ k Int (EnumSet e)
forall k e.
Ord k =>
(k, EnumSet e)
-> OrdPSQ k Int (EnumSet e) -> OrdPSQ k Int (EnumSet e)
deleteSetFromPSQ) OrdPSQ k Int (EnumSet e)
q (Map k (EnumSet e) -> OrdPSQ k Int (EnumSet e))
-> (EnumMap e (Set k) -> Map k (EnumSet e))
-> EnumMap e (Set k)
-> OrdPSQ k Int (EnumSet e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap e (Set k) -> Map k (EnumSet e)
forall e a.
(Enum e, Ord a) =>
EnumMap e (Set a) -> Map a (EnumSet e)
EnumMapX.transposeSet

deleteSetFromPSQ ::
   (Ord k) =>
   (k, EnumSet e) -> PSQ.OrdPSQ k Int (EnumSet e) ->
   PSQ.OrdPSQ k Int (EnumSet e)
deleteSetFromPSQ :: forall k e.
Ord k =>
(k, EnumSet e)
-> OrdPSQ k Int (EnumSet e) -> OrdPSQ k Int (EnumSet e)
deleteSetFromPSQ (k
elm, EnumSet e
ns) =
   ((Int, EnumSet e) -> (Int, EnumSet e))
-> k -> OrdPSQ k Int (EnumSet e) -> OrdPSQ k Int (EnumSet e)
forall p k v.
(Ord p, Ord k) =>
((p, v) -> (p, v)) -> k -> OrdPSQ k p v -> OrdPSQ k 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) k
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, Ord k) =>
   ((p, v) -> (p, v)) -> k -> PSQ.OrdPSQ k p v -> PSQ.OrdPSQ k p v
updatePSQ :: forall p k v.
(Ord p, Ord k) =>
((p, v) -> (p, v)) -> k -> OrdPSQ k p v -> OrdPSQ k p v
updatePSQ (p, v) -> (p, v)
f k
k = ((), OrdPSQ k p v) -> OrdPSQ k p v
forall a b. (a, b) -> b
snd (((), OrdPSQ k p v) -> OrdPSQ k p v)
-> (OrdPSQ k p v -> ((), OrdPSQ k p v))
-> OrdPSQ k p v
-> OrdPSQ k p v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (p, v) -> ((), Maybe (p, v)))
-> k -> OrdPSQ k p v -> ((), OrdPSQ k p v)
forall k p v b.
(Ord k, Ord p) =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> k -> OrdPSQ k p v -> (b, OrdPSQ k 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) k
k