module Math.SetCover.Queue.Map (Methods, methods) where

import qualified Math.SetCover.Queue as Queue

import qualified Math.SetCover.EnumMap as EnumMapX
import qualified Data.OrdPSQ as PSQ
import qualified Data.EnumSet as EnumSet
import qualified Data.Map as Map; import Data.Map (Map)
import Control.Applicative ((<$>))
import Data.Monoid (Monoid, mempty, mappend)
import Data.Maybe (mapMaybe, fromMaybe)
import Data.Tuple.HT (mapFst, mapSnd)


type Methods a queue set = Queue.Methods (PSQ.OrdPSQ a Int queue) (Map a set)

methods :: Ord a => Queue.Methods queue set -> Methods a queue set
methods :: forall a queue set.
Ord a =>
Methods queue set -> Methods a queue set
methods Methods queue set
m =
   Queue.Methods {
      fromEnumMap :: EnumMap SetId (Map a set) -> OrdPSQ a Int queue
Queue.fromEnumMap =
         [(a, Int, queue)] -> OrdPSQ a Int queue
forall k p v. (Ord k, Ord p) => [(k, p, v)] -> OrdPSQ k p v
PSQ.fromList ([(a, Int, queue)] -> OrdPSQ a Int queue)
-> (EnumMap SetId (Map a set) -> [(a, Int, queue)])
-> EnumMap SetId (Map a set)
-> OrdPSQ a Int queue
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         ((a, EnumMap SetId set) -> Maybe (a, Int, queue))
-> [(a, EnumMap SetId set)] -> [(a, Int, queue)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
            (\(a
elm, EnumMap SetId set
sets) ->
               (\(Int
minSize, queue
ns) -> (a
elm, Int
minSize, queue
ns)) ((Int, queue) -> (a, Int, queue))
-> Maybe (Int, queue) -> Maybe (a, Int, queue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
               (Methods queue set -> queue -> Maybe (Int, queue)
forall queue set. Methods queue set -> queue -> Maybe (Int, queue)
addMinSize Methods queue set
m (queue -> Maybe (Int, queue)) -> queue -> Maybe (Int, queue)
forall a b. (a -> b) -> a -> b
$ Methods queue set -> EnumMap SetId set -> queue
forall queue set. Methods queue set -> EnumMap SetId set -> queue
Queue.fromEnumMap Methods queue set
m EnumMap SetId set
sets)) ([(a, EnumMap SetId set)] -> [(a, Int, queue)])
-> (EnumMap SetId (Map a set) -> [(a, EnumMap SetId set)])
-> EnumMap SetId (Map a set)
-> [(a, Int, queue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         Map a (EnumMap SetId set) -> [(a, EnumMap SetId set)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map a (EnumMap SetId set) -> [(a, EnumMap SetId set)])
-> (EnumMap SetId (Map a set) -> Map a (EnumMap SetId set))
-> EnumMap SetId (Map a set)
-> [(a, EnumMap SetId set)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap SetId (Map a set) -> Map a (EnumMap SetId set)
forall e a b.
(Enum e, Ord a) =>
EnumMap e (Map a b) -> Map a (EnumMap e b)
EnumMapX.transposeMap,
      partition :: OrdPSQ a Int queue
-> Map a set -> (EnumSet SetId, OrdPSQ a Int queue)
Queue.partition =
         (queue -> set -> (EnumSet SetId, Maybe (Int, queue)))
-> OrdPSQ a Int queue
-> Map a set
-> (EnumSet SetId, OrdPSQ a Int queue)
forall p k c v b.
(Ord p, Ord k, Monoid c) =>
(v -> b -> (c, Maybe (p, v)))
-> OrdPSQ k p v -> Map k b -> (c, OrdPSQ k p v)
applyWriter (((queue -> Maybe (Int, queue))
-> (EnumSet SetId, queue) -> (EnumSet SetId, Maybe (Int, queue))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (Methods queue set -> queue -> Maybe (Int, queue)
forall queue set. Methods queue set -> queue -> Maybe (Int, queue)
addMinSize Methods queue set
m) ((EnumSet SetId, queue) -> (EnumSet SetId, Maybe (Int, queue)))
-> (set -> (EnumSet SetId, queue))
-> set
-> (EnumSet SetId, Maybe (Int, queue))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((set -> (EnumSet SetId, queue))
 -> set -> (EnumSet SetId, Maybe (Int, queue)))
-> (queue -> set -> (EnumSet SetId, queue))
-> queue
-> set
-> (EnumSet SetId, Maybe (Int, queue))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Methods queue set -> queue -> set -> (EnumSet SetId, queue)
forall queue set.
Methods queue set -> queue -> set -> (EnumSet SetId, queue)
Queue.partition Methods queue set
m),
      difference :: OrdPSQ a Int queue
-> EnumMap SetId (Map a set) -> OrdPSQ a Int queue
Queue.difference = \OrdPSQ a Int queue
q EnumMap SetId (Map a set)
s ->
         (queue -> EnumMap SetId set -> Maybe (Int, queue))
-> OrdPSQ a Int queue
-> Map a (EnumMap SetId set)
-> OrdPSQ a Int queue
forall k p a b.
(Ord k, Ord p) =>
(a -> b -> Maybe (p, a)) -> OrdPSQ k p a -> Map k b -> OrdPSQ k p a
apply ((Methods queue set -> queue -> Maybe (Int, queue)
forall queue set. Methods queue set -> queue -> Maybe (Int, queue)
addMinSize Methods queue set
m (queue -> Maybe (Int, queue))
-> (EnumMap SetId set -> queue)
-> EnumMap SetId set
-> Maybe (Int, queue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((EnumMap SetId set -> queue)
 -> EnumMap SetId set -> Maybe (Int, queue))
-> (queue -> EnumMap SetId set -> queue)
-> queue
-> EnumMap SetId set
-> Maybe (Int, queue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Methods queue set -> queue -> EnumMap SetId set -> queue
forall queue set.
Methods queue set -> queue -> EnumMap SetId set -> queue
Queue.difference Methods queue set
m)
            OrdPSQ a Int queue
q (EnumMap SetId (Map a set) -> Map a (EnumMap SetId set)
forall e a b.
(Enum e, Ord a) =>
EnumMap e (Map a b) -> Map a (EnumMap e b)
EnumMapX.transposeMap EnumMap SetId (Map a set)
s),
      findMinValue :: OrdPSQ a Int queue -> Maybe (Map a set, EnumSet SetId)
Queue.findMinValue = \OrdPSQ a Int queue
qo -> do
         (a
elm,Int
_,queue
qi) <- OrdPSQ a Int queue -> Maybe (a, Int, queue)
forall k p v. OrdPSQ k p v -> Maybe (k, p, v)
PSQ.findMin OrdPSQ a Int queue
qo
         let (set
minSet,EnumSet SetId
ns) =
               String -> Maybe (set, EnumSet SetId) -> (set, EnumSet SetId)
forall queue. String -> Maybe queue -> queue
checkSubQueue String
"findMinValue" (Maybe (set, EnumSet SetId) -> (set, EnumSet SetId))
-> Maybe (set, EnumSet SetId) -> (set, EnumSet SetId)
forall a b. (a -> b) -> a -> b
$ Methods queue set -> queue -> Maybe (set, EnumSet SetId)
forall queue set.
Methods queue set -> queue -> Maybe (set, EnumSet SetId)
Queue.findMinValue Methods queue set
m queue
qi
         (Map a set, EnumSet SetId) -> Maybe (Map a set, EnumSet SetId)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> set -> Map a set
forall k a. k -> a -> Map k a
Map.singleton a
elm set
minSet, EnumSet SetId
ns),
      null :: OrdPSQ a Int queue -> Bool
Queue.null = OrdPSQ a Int queue -> Bool
forall k p v. OrdPSQ k p v -> Bool
PSQ.null
   }

checkSubQueue :: String -> Maybe queue -> queue
checkSubQueue :: forall queue. String -> Maybe queue -> queue
checkSubQueue String
name =
   queue -> Maybe queue -> queue
forall a. a -> Maybe a -> a
fromMaybe (String -> queue
forall a. HasCallStack => String -> a
error (String
"Queue.Map." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": empty sub-queue"))

addMinSize :: Queue.Methods queue set -> queue -> Maybe (Int, queue)
addMinSize :: forall queue set. Methods queue set -> queue -> Maybe (Int, queue)
addMinSize Methods queue set
m queue
q = (Int -> queue -> (Int, queue)) -> queue -> Int -> (Int, queue)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) queue
q (Int -> (Int, queue))
-> (EnumSet SetId -> Int) -> EnumSet SetId -> (Int, queue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumSet SetId -> Int
forall k. EnumSet k -> Int
EnumSet.size (EnumSet SetId -> (Int, queue))
-> Maybe (EnumSet SetId) -> Maybe (Int, queue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Methods queue set -> queue -> Maybe (EnumSet SetId)
forall queue set.
Methods queue set -> queue -> Maybe (EnumSet SetId)
Queue.findMin Methods queue set
m queue
q

applyWriter ::
   (Ord p, Ord k, Monoid c) =>
   (v -> b -> (c, Maybe (p, v))) ->
   PSQ.OrdPSQ k p v -> Map k b -> (c, PSQ.OrdPSQ k p v)
applyWriter :: forall p k c v b.
(Ord p, Ord k, Monoid c) =>
(v -> b -> (c, Maybe (p, v)))
-> OrdPSQ k p v -> Map k b -> (c, OrdPSQ k p v)
applyWriter v -> b -> (c, Maybe (p, v))
f OrdPSQ k p v
q =
   ((c, OrdPSQ k p v) -> k -> b -> (c, OrdPSQ k p v))
-> (c, OrdPSQ k p v) -> Map k b -> (c, OrdPSQ k p v)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey
      (\(c
sis, OrdPSQ k p v
qi) k
a b
ss ->
         (c -> c) -> (c, OrdPSQ k p v) -> (c, OrdPSQ k p v)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (c -> c -> c
forall a. Monoid a => a -> a -> a
mappend c
sis) ((c, OrdPSQ k p v) -> (c, OrdPSQ k p v))
-> (c, OrdPSQ k p v) -> (c, OrdPSQ k p v)
forall a b. (a -> b) -> a -> b
$
         (Maybe (p, v) -> (c, Maybe (p, v)))
-> k -> OrdPSQ k p v -> (c, 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 ((c, Maybe (p, v))
-> ((p, v) -> (c, Maybe (p, v)))
-> Maybe (p, v)
-> (c, Maybe (p, v))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (c
forall a. Monoid a => a
mempty, Maybe (p, v)
forall a. Maybe a
Nothing) (((p, v) -> (c, Maybe (p, v)))
 -> Maybe (p, v) -> (c, Maybe (p, v)))
-> ((p, v) -> (c, Maybe (p, v)))
-> Maybe (p, v)
-> (c, Maybe (p, v))
forall a b. (a -> b) -> a -> b
$ \(p
_p,v
subq) -> v -> b -> (c, Maybe (p, v))
f v
subq b
ss) k
a OrdPSQ k p v
qi)
      (c
forall a. Monoid a => a
mempty,OrdPSQ k p v
q)

apply ::
   (Ord k, Ord p) =>
   (a -> b -> Maybe (p, a)) ->
   PSQ.OrdPSQ k p a -> Map k b -> PSQ.OrdPSQ k p a
apply :: forall k p a b.
(Ord k, Ord p) =>
(a -> b -> Maybe (p, a)) -> OrdPSQ k p a -> Map k b -> OrdPSQ k p a
apply a -> b -> Maybe (p, a)
f =
   (OrdPSQ k p a -> k -> b -> OrdPSQ k p a)
-> OrdPSQ k p a -> Map k b -> OrdPSQ k p a
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey (\OrdPSQ k p a
qi k
a b
ss -> ((p, a) -> Maybe (p, a)) -> k -> OrdPSQ k p a -> OrdPSQ k p a
forall p k v.
(Ord p, Ord k) =>
((p, v) -> Maybe (p, v)) -> k -> OrdPSQ k p v -> OrdPSQ k p v
updatePSQ (\(p
_p,a
subq) -> a -> b -> Maybe (p, a)
f a
subq b
ss) k
a OrdPSQ k p a
qi)

updatePSQ ::
   (Ord p, Ord k) =>
   ((p, v) -> Maybe (p, v)) -> k -> PSQ.OrdPSQ k p v -> PSQ.OrdPSQ k p v
updatePSQ :: forall p k v.
(Ord p, Ord k) =>
((p, v) -> Maybe (p, v)) -> k -> OrdPSQ k p v -> OrdPSQ k p v
updatePSQ (p, v) -> Maybe (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) -> Maybe (p, v)
f((p, v) -> Maybe (p, v)) -> Maybe (p, v) -> Maybe (p, v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)) k
k