{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Control.Monad.Trans.UnionFind
( UnionFindT, runUnionFind
, Point, fresh, repr, descriptor, union, equivalent
) where
import Control.Applicative (Applicative)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.State (StateT(..), evalStateT)
import Data.UnionFind.IntMap (Point)
import qualified Control.Monad.Trans.State as State
import qualified Data.UnionFind.IntMap as UF
newtype UnionFindT p m a = UnionFindT {
UnionFindT p m a -> StateT (PointSupply p) m a
unUnionFindT :: StateT (UF.PointSupply p) m a
} deriving (a -> UnionFindT p m b -> UnionFindT p m a
(a -> b) -> UnionFindT p m a -> UnionFindT p m b
(forall a b. (a -> b) -> UnionFindT p m a -> UnionFindT p m b)
-> (forall a b. a -> UnionFindT p m b -> UnionFindT p m a)
-> Functor (UnionFindT p m)
forall a b. a -> UnionFindT p m b -> UnionFindT p m a
forall a b. (a -> b) -> UnionFindT p m a -> UnionFindT p m b
forall p (m :: * -> *) a b.
Functor m =>
a -> UnionFindT p m b -> UnionFindT p m a
forall p (m :: * -> *) a b.
Functor m =>
(a -> b) -> UnionFindT p m a -> UnionFindT p m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> UnionFindT p m b -> UnionFindT p m a
$c<$ :: forall p (m :: * -> *) a b.
Functor m =>
a -> UnionFindT p m b -> UnionFindT p m a
fmap :: (a -> b) -> UnionFindT p m a -> UnionFindT p m b
$cfmap :: forall p (m :: * -> *) a b.
Functor m =>
(a -> b) -> UnionFindT p m a -> UnionFindT p m b
Functor, Functor (UnionFindT p m)
a -> UnionFindT p m a
Functor (UnionFindT p m) =>
(forall a. a -> UnionFindT p m a)
-> (forall a b.
UnionFindT p m (a -> b) -> UnionFindT p m a -> UnionFindT p m b)
-> (forall a b c.
(a -> b -> c)
-> UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m c)
-> (forall a b.
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m b)
-> (forall a b.
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m a)
-> Applicative (UnionFindT p m)
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m b
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m a
UnionFindT p m (a -> b) -> UnionFindT p m a -> UnionFindT p m b
(a -> b -> c)
-> UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m c
forall a. a -> UnionFindT p m a
forall a b.
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m a
forall a b.
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m b
forall a b.
UnionFindT p m (a -> b) -> UnionFindT p m a -> UnionFindT p m b
forall a b c.
(a -> b -> c)
-> UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m c
forall p (m :: * -> *). Monad m => Functor (UnionFindT p m)
forall p (m :: * -> *) a. Monad m => a -> UnionFindT p m a
forall p (m :: * -> *) a b.
Monad m =>
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m a
forall p (m :: * -> *) a b.
Monad m =>
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m b
forall p (m :: * -> *) a b.
Monad m =>
UnionFindT p m (a -> b) -> UnionFindT p m a -> UnionFindT p m b
forall p (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m a
$c<* :: forall p (m :: * -> *) a b.
Monad m =>
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m a
*> :: UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m b
$c*> :: forall p (m :: * -> *) a b.
Monad m =>
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m b
liftA2 :: (a -> b -> c)
-> UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m c
$cliftA2 :: forall p (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m c
<*> :: UnionFindT p m (a -> b) -> UnionFindT p m a -> UnionFindT p m b
$c<*> :: forall p (m :: * -> *) a b.
Monad m =>
UnionFindT p m (a -> b) -> UnionFindT p m a -> UnionFindT p m b
pure :: a -> UnionFindT p m a
$cpure :: forall p (m :: * -> *) a. Monad m => a -> UnionFindT p m a
$cp1Applicative :: forall p (m :: * -> *). Monad m => Functor (UnionFindT p m)
Applicative, Applicative (UnionFindT p m)
a -> UnionFindT p m a
Applicative (UnionFindT p m) =>
(forall a b.
UnionFindT p m a -> (a -> UnionFindT p m b) -> UnionFindT p m b)
-> (forall a b.
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m b)
-> (forall a. a -> UnionFindT p m a)
-> Monad (UnionFindT p m)
UnionFindT p m a -> (a -> UnionFindT p m b) -> UnionFindT p m b
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m b
forall a. a -> UnionFindT p m a
forall a b.
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m b
forall a b.
UnionFindT p m a -> (a -> UnionFindT p m b) -> UnionFindT p m b
forall p (m :: * -> *). Monad m => Applicative (UnionFindT p m)
forall p (m :: * -> *) a. Monad m => a -> UnionFindT p m a
forall p (m :: * -> *) a b.
Monad m =>
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m b
forall p (m :: * -> *) a b.
Monad m =>
UnionFindT p m a -> (a -> UnionFindT p m b) -> UnionFindT p m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> UnionFindT p m a
$creturn :: forall p (m :: * -> *) a. Monad m => a -> UnionFindT p m a
>> :: UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m b
$c>> :: forall p (m :: * -> *) a b.
Monad m =>
UnionFindT p m a -> UnionFindT p m b -> UnionFindT p m b
>>= :: UnionFindT p m a -> (a -> UnionFindT p m b) -> UnionFindT p m b
$c>>= :: forall p (m :: * -> *) a b.
Monad m =>
UnionFindT p m a -> (a -> UnionFindT p m b) -> UnionFindT p m b
$cp1Monad :: forall p (m :: * -> *). Monad m => Applicative (UnionFindT p m)
Monad, m a -> UnionFindT p m a
(forall (m :: * -> *) a. Monad m => m a -> UnionFindT p m a)
-> MonadTrans (UnionFindT p)
forall p (m :: * -> *) a. Monad m => m a -> UnionFindT p m a
forall (m :: * -> *) a. Monad m => m a -> UnionFindT p m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> UnionFindT p m a
$clift :: forall p (m :: * -> *) a. Monad m => m a -> UnionFindT p m a
MonadTrans)
runUnionFind :: Monad m => UnionFindT p m a -> m a
runUnionFind :: UnionFindT p m a -> m a
runUnionFind = (StateT (PointSupply p) m a -> PointSupply p -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`evalStateT` PointSupply p
forall a. PointSupply a
UF.newPointSupply) (StateT (PointSupply p) m a -> m a)
-> (UnionFindT p m a -> StateT (PointSupply p) m a)
-> UnionFindT p m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnionFindT p m a -> StateT (PointSupply p) m a
forall p (m :: * -> *) a.
UnionFindT p m a -> StateT (PointSupply p) m a
unUnionFindT
swap :: (a, b) -> (b, a)
swap :: (a, b) -> (b, a)
swap (x :: a
x, y :: b
y) = (b
y, a
x)
fresh :: Monad m => p -> UnionFindT p m (Point p)
fresh :: p -> UnionFindT p m (Point p)
fresh x :: p
x = StateT (PointSupply p) m (Point p) -> UnionFindT p m (Point p)
forall p (m :: * -> *) a.
StateT (PointSupply p) m a -> UnionFindT p m a
UnionFindT (StateT (PointSupply p) m (Point p) -> UnionFindT p m (Point p))
-> ((PointSupply p -> m (Point p, PointSupply p))
-> StateT (PointSupply p) m (Point p))
-> (PointSupply p -> m (Point p, PointSupply p))
-> UnionFindT p m (Point p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PointSupply p -> m (Point p, PointSupply p))
-> StateT (PointSupply p) m (Point p)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((PointSupply p -> m (Point p, PointSupply p))
-> UnionFindT p m (Point p))
-> (PointSupply p -> m (Point p, PointSupply p))
-> UnionFindT p m (Point p)
forall a b. (a -> b) -> a -> b
$ (Point p, PointSupply p) -> m (Point p, PointSupply p)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Point p, PointSupply p) -> m (Point p, PointSupply p))
-> (PointSupply p -> (Point p, PointSupply p))
-> PointSupply p
-> m (Point p, PointSupply p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PointSupply p, Point p) -> (Point p, PointSupply p)
forall a b. (a, b) -> (b, a)
swap ((PointSupply p, Point p) -> (Point p, PointSupply p))
-> (PointSupply p -> (PointSupply p, Point p))
-> PointSupply p
-> (Point p, PointSupply p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PointSupply p -> p -> (PointSupply p, Point p))
-> p -> PointSupply p -> (PointSupply p, Point p)
forall a b c. (a -> b -> c) -> b -> a -> c
flip PointSupply p -> p -> (PointSupply p, Point p)
forall a. PointSupply a -> a -> (PointSupply a, Point a)
UF.fresh p
x
repr :: Monad m => Point p -> UnionFindT p m (Point p)
repr :: Point p -> UnionFindT p m (Point p)
repr = StateT (PointSupply p) m (Point p) -> UnionFindT p m (Point p)
forall p (m :: * -> *) a.
StateT (PointSupply p) m a -> UnionFindT p m a
UnionFindT (StateT (PointSupply p) m (Point p) -> UnionFindT p m (Point p))
-> (Point p -> StateT (PointSupply p) m (Point p))
-> Point p
-> UnionFindT p m (Point p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PointSupply p -> Point p) -> StateT (PointSupply p) m (Point p)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets ((PointSupply p -> Point p) -> StateT (PointSupply p) m (Point p))
-> (Point p -> PointSupply p -> Point p)
-> Point p
-> StateT (PointSupply p) m (Point p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PointSupply p -> Point p -> Point p)
-> Point p -> PointSupply p -> Point p
forall a b c. (a -> b -> c) -> b -> a -> c
flip PointSupply p -> Point p -> Point p
forall a. PointSupply a -> Point a -> Point a
UF.repr
descriptor :: Monad m => Point p -> UnionFindT p m p
descriptor :: Point p -> UnionFindT p m p
descriptor = StateT (PointSupply p) m p -> UnionFindT p m p
forall p (m :: * -> *) a.
StateT (PointSupply p) m a -> UnionFindT p m a
UnionFindT (StateT (PointSupply p) m p -> UnionFindT p m p)
-> (Point p -> StateT (PointSupply p) m p)
-> Point p
-> UnionFindT p m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PointSupply p -> p) -> StateT (PointSupply p) m p
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets ((PointSupply p -> p) -> StateT (PointSupply p) m p)
-> (Point p -> PointSupply p -> p)
-> Point p
-> StateT (PointSupply p) m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PointSupply p -> Point p -> p) -> Point p -> PointSupply p -> p
forall a b c. (a -> b -> c) -> b -> a -> c
flip PointSupply p -> Point p -> p
forall a. PointSupply a -> Point a -> a
UF.descriptor
union :: Monad m => Point p -> Point p -> UnionFindT p m ()
union :: Point p -> Point p -> UnionFindT p m ()
union p1 :: Point p
p1 p2 :: Point p
p2 = StateT (PointSupply p) m () -> UnionFindT p m ()
forall p (m :: * -> *) a.
StateT (PointSupply p) m a -> UnionFindT p m a
UnionFindT (StateT (PointSupply p) m () -> UnionFindT p m ())
-> ((PointSupply p -> PointSupply p)
-> StateT (PointSupply p) m ())
-> (PointSupply p -> PointSupply p)
-> UnionFindT p m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PointSupply p -> PointSupply p) -> StateT (PointSupply p) m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify ((PointSupply p -> PointSupply p) -> UnionFindT p m ())
-> (PointSupply p -> PointSupply p) -> UnionFindT p m ()
forall a b. (a -> b) -> a -> b
$ \x :: PointSupply p
x -> PointSupply p -> Point p -> Point p -> PointSupply p
forall a. PointSupply a -> Point a -> Point a -> PointSupply a
UF.union PointSupply p
x Point p
p1 Point p
p2
equivalent :: Monad m => Point p -> Point p -> UnionFindT p m Bool
equivalent :: Point p -> Point p -> UnionFindT p m Bool
equivalent p1 :: Point p
p1 p2 :: Point p
p2 = StateT (PointSupply p) m Bool -> UnionFindT p m Bool
forall p (m :: * -> *) a.
StateT (PointSupply p) m a -> UnionFindT p m a
UnionFindT (StateT (PointSupply p) m Bool -> UnionFindT p m Bool)
-> ((PointSupply p -> Bool) -> StateT (PointSupply p) m Bool)
-> (PointSupply p -> Bool)
-> UnionFindT p m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PointSupply p -> Bool) -> StateT (PointSupply p) m Bool
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets ((PointSupply p -> Bool) -> UnionFindT p m Bool)
-> (PointSupply p -> Bool) -> UnionFindT p m Bool
forall a b. (a -> b) -> a -> b
$ \x :: PointSupply p
x -> PointSupply p -> Point p -> Point p -> Bool
forall a. PointSupply a -> Point a -> Point a -> Bool
UF.equivalent PointSupply p
x Point p
p1 Point p
p2