{-# LANGUAGE DeriveAnyClass #-}

-- | See 'EquivFind'.
module Overeasy.EquivFind
  ( EquivFind
  , efFwd
  , efBwd
  , efRootsSize
  , efLeavesSize
  , efTotalSize
  , efCanonicalize
  , efCanonicalizePartial
  , efNew
  , efSingleton
  , efMember
  , efRoots
  , efLeaves
  , efMembers
  , EquivAddRes (..)
  , efAddInc
  , efAdd
  , efEquivs
  , efClosure
  , efFindRoot
  , efFindLeaves
  , efSubset
  , efLookupRoot
  , efLookupLeaves
  , efFindAll
  , EquivMergeRes (..)
  , efUnsafeMerge
  , efMergeInc
  , efMerge
  , EquivMergeSetsRes (..)
  , efMergeSetsInc
  , efMergeSets
  , efCanCompact
  , efCompactInc
  , efCompact
  , efRemoveAllInc
  , efRemoveAll
  , efUnsafeAddLeafInc
  ) where

import Control.Applicative ((<|>))
import Control.DeepSeq (NFData)
import Control.Monad.State.Strict (State, state)
import Data.Coerce (Coercible)
import Data.Foldable (foldl')
import Data.Maybe (fromJust, fromMaybe)
import GHC.Generics (Generic)
import IntLike.Map (IntLikeMap)
import qualified IntLike.Map as ILM
import IntLike.Set (IntLikeSet)
import qualified IntLike.Set as ILS

-- | A "Union-Find" implementation using explicit equivalence classes.
-- Sure, the asympotics aren't as good, but we eventually have to construct these
-- classes, so we might as well just do it as we go!
data EquivFind x = EquivFind
  { forall x. EquivFind x -> IntLikeMap x (IntLikeSet x)
efFwd :: !(IntLikeMap x (IntLikeSet x))
  -- ^ Map of root to equivalent leaves
  -- Invariant: Map keys are only roots
  -- Invariant: Sets only contain leaf keys (and not the root itself)
  , forall x. EquivFind x -> IntLikeMap x x
efBwd :: !(IntLikeMap x x)
  -- ^ Map of leaf to root
  -- Invariant: Map keys are only leaves, values are only roots
  } deriving stock (EquivFind x -> EquivFind x -> Bool
forall x. Eq x => EquivFind x -> EquivFind x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EquivFind x -> EquivFind x -> Bool
$c/= :: forall x. Eq x => EquivFind x -> EquivFind x -> Bool
== :: EquivFind x -> EquivFind x -> Bool
$c== :: forall x. Eq x => EquivFind x -> EquivFind x -> Bool
Eq, Int -> EquivFind x -> ShowS
forall x. Show x => Int -> EquivFind x -> ShowS
forall x. Show x => [EquivFind x] -> ShowS
forall x. Show x => EquivFind x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EquivFind x] -> ShowS
$cshowList :: forall x. Show x => [EquivFind x] -> ShowS
show :: EquivFind x -> String
$cshow :: forall x. Show x => EquivFind x -> String
showsPrec :: Int -> EquivFind x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> EquivFind x -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (EquivFind x) x -> EquivFind x
forall x x. EquivFind x -> Rep (EquivFind x) x
$cto :: forall x x. Rep (EquivFind x) x -> EquivFind x
$cfrom :: forall x x. EquivFind x -> Rep (EquivFind x) x
Generic)
    deriving anyclass (forall x. NFData x => EquivFind x -> ()
forall a. (a -> ()) -> NFData a
rnf :: EquivFind x -> ()
$crnf :: forall x. NFData x => EquivFind x -> ()
NFData)

-- | Number of roots in the equiv.
efRootsSize :: EquivFind x -> Int
efRootsSize :: forall x. EquivFind x -> Int
efRootsSize = forall x a. IntLikeMap x a -> Int
ILM.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. EquivFind x -> IntLikeMap x (IntLikeSet x)
efFwd

-- | Number of leaves in the equiv.
efLeavesSize :: EquivFind x -> Int
efLeavesSize :: forall x. EquivFind x -> Int
efLeavesSize = forall x a. IntLikeMap x a -> Int
ILM.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. EquivFind x -> IntLikeMap x x
efBwd

-- | Total number of keys in the equiv.
efTotalSize :: EquivFind x -> Int
efTotalSize :: forall x. EquivFind x -> Int
efTotalSize EquivFind x
ef = forall x. EquivFind x -> Int
efRootsSize EquivFind x
ef forall a. Num a => a -> a -> a
+ forall x. EquivFind x -> Int
efLeavesSize EquivFind x
ef

-- | Canonicalize the given expression functor by replacing leaves with roots.
-- If any elements are missing, the first is returned.
efCanonicalize :: (Traversable f, Coercible x Int) => f x -> EquivFind x -> Either x (f x)
efCanonicalize :: forall (f :: * -> *) x.
(Traversable f, Coercible x Int) =>
f x -> EquivFind x -> Either x (f x)
efCanonicalize f x
fx EquivFind x
ef = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\x
x -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left x
x) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall x. Coercible x Int => x -> EquivFind x -> Maybe x
efFindRoot x
x EquivFind x
ef)) f x
fx

-- | Canonicalize the given expression functor by replacing leaves with roots.
-- If any elements are missing, they are simply skipped.
efCanonicalizePartial :: (Functor f, Coercible x Int) => f x -> EquivFind x -> f x
efCanonicalizePartial :: forall (f :: * -> *) x.
(Functor f, Coercible x Int) =>
f x -> EquivFind x -> f x
efCanonicalizePartial f x
fx EquivFind x
ef = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. Coercible x Int => x -> EquivFind x -> x
`efLookupRoot` EquivFind x
ef) f x
fx

-- | Creates an empty equiv
efNew :: EquivFind x
efNew :: forall x. EquivFind x
efNew = forall x.
IntLikeMap x (IntLikeSet x) -> IntLikeMap x x -> EquivFind x
EquivFind forall x a. IntLikeMap x a
ILM.empty forall x a. IntLikeMap x a
ILM.empty

-- | Creates a singleton equiv
efSingleton :: Coercible x Int => x -> EquivFind x
efSingleton :: forall x. Coercible x Int => x -> EquivFind x
efSingleton x
x = forall x.
IntLikeMap x (IntLikeSet x) -> IntLikeMap x x -> EquivFind x
EquivFind (forall x a. Coercible x Int => x -> a -> IntLikeMap x a
ILM.singleton x
x forall x. IntLikeSet x
ILS.empty) forall x a. IntLikeMap x a
ILM.empty

-- private
allocMM :: Coercible x Int => x -> IntLikeMap x (IntLikeSet x) -> IntLikeMap x (IntLikeSet x)
allocMM :: forall x.
Coercible x Int =>
x -> IntLikeMap x (IntLikeSet x) -> IntLikeMap x (IntLikeSet x)
allocMM = forall x a.
Coercible x Int =>
(Maybe a -> Maybe a) -> x -> IntLikeMap x a -> IntLikeMap x a
ILM.alter (forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just forall x. IntLikeSet x
ILS.empty)

-- private
insertMM :: Coercible x Int => x -> x -> IntLikeMap x (IntLikeSet x) -> IntLikeMap x (IntLikeSet x)
insertMM :: forall x.
Coercible x Int =>
x
-> x -> IntLikeMap x (IntLikeSet x) -> IntLikeMap x (IntLikeSet x)
insertMM x
x x
y = forall x a.
Coercible x Int =>
(Maybe a -> Maybe a) -> x -> IntLikeMap x a -> IntLikeMap x a
ILM.alter (\case { Maybe (IntLikeSet x)
Nothing -> forall a. a -> Maybe a
Just (forall x. Coercible x Int => x -> IntLikeSet x
ILS.singleton x
y); Just IntLikeSet x
s -> forall a. a -> Maybe a
Just (forall x. Coercible x Int => x -> IntLikeSet x -> IntLikeSet x
ILS.insert x
y IntLikeSet x
s) }) x
x

-- | Result of adding something to the equiv, if you're interested.
data EquivAddRes x =
    EquivAddResAlreadyRoot
  | EquivAddResAlreadyLeafOf !x
  | EquivAddResNewRoot
  deriving stock (EquivAddRes x -> EquivAddRes x -> Bool
forall x. Eq x => EquivAddRes x -> EquivAddRes x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EquivAddRes x -> EquivAddRes x -> Bool
$c/= :: forall x. Eq x => EquivAddRes x -> EquivAddRes x -> Bool
== :: EquivAddRes x -> EquivAddRes x -> Bool
$c== :: forall x. Eq x => EquivAddRes x -> EquivAddRes x -> Bool
Eq, Int -> EquivAddRes x -> ShowS
forall x. Show x => Int -> EquivAddRes x -> ShowS
forall x. Show x => [EquivAddRes x] -> ShowS
forall x. Show x => EquivAddRes x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EquivAddRes x] -> ShowS
$cshowList :: forall x. Show x => [EquivAddRes x] -> ShowS
show :: EquivAddRes x -> String
$cshow :: forall x. Show x => EquivAddRes x -> String
showsPrec :: Int -> EquivAddRes x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> EquivAddRes x -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (EquivAddRes x) x -> EquivAddRes x
forall x x. EquivAddRes x -> Rep (EquivAddRes x) x
$cto :: forall x x. Rep (EquivAddRes x) x -> EquivAddRes x
$cfrom :: forall x x. EquivAddRes x -> Rep (EquivAddRes x) x
Generic)
  deriving anyclass (forall x. NFData x => EquivAddRes x -> ()
forall a. (a -> ()) -> NFData a
rnf :: EquivAddRes x -> ()
$crnf :: forall x. NFData x => EquivAddRes x -> ()
NFData)

-- | Add the given key to the equiv (raw version).
efAddInc :: Coercible x Int => x -> EquivFind x -> (EquivAddRes x, EquivFind x)
efAddInc :: forall x.
Coercible x Int =>
x -> EquivFind x -> (EquivAddRes x, EquivFind x)
efAddInc x
x ef :: EquivFind x
ef@(EquivFind IntLikeMap x (IntLikeSet x)
fwd IntLikeMap x x
bwd) =
  case forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup x
x IntLikeMap x x
bwd of
    Maybe x
Nothing ->
      if forall x a. Coercible x Int => x -> IntLikeMap x a -> Bool
ILM.member x
x IntLikeMap x (IntLikeSet x)
fwd
        then (forall x. EquivAddRes x
EquivAddResAlreadyRoot, EquivFind x
ef)
        else (forall x. EquivAddRes x
EquivAddResNewRoot, forall x.
IntLikeMap x (IntLikeSet x) -> IntLikeMap x x -> EquivFind x
EquivFind (forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert x
x forall x. IntLikeSet x
ILS.empty IntLikeMap x (IntLikeSet x)
fwd) IntLikeMap x x
bwd)
    Just x
y -> (forall x. x -> EquivAddRes x
EquivAddResAlreadyLeafOf x
y, EquivFind x
ef)

-- | Add the given key to the equiv (raw version).
efAdd :: Coercible x Int => x -> State (EquivFind x) (EquivAddRes x)
efAdd :: forall x.
Coercible x Int =>
x -> State (EquivFind x) (EquivAddRes x)
efAdd = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x.
Coercible x Int =>
x -> EquivFind x -> (EquivAddRes x, EquivFind x)
efAddInc

-- | All keys equivalent to the given key in the equiv.
-- Always returns a set with the given key, even if it's not present.
efEquivs :: Coercible x Int => x -> EquivFind x -> IntLikeSet x
efEquivs :: forall x. Coercible x Int => x -> EquivFind x -> IntLikeSet x
efEquivs x
x EquivFind x
ef = let r :: x
r = forall x. Coercible x Int => x -> EquivFind x -> x
efLookupRoot x
x EquivFind x
ef in forall x. Coercible x Int => x -> IntLikeSet x -> IntLikeSet x
ILS.insert x
r (forall x. Coercible x Int => x -> EquivFind x -> IntLikeSet x
efLookupLeaves x
r EquivFind x
ef)

-- | Set of all keys equivalent to the given keys in the equiv.
efClosure :: Coercible x Int => [x] -> EquivFind x -> IntLikeSet x
efClosure :: forall x. Coercible x Int => [x] -> EquivFind x -> IntLikeSet x
efClosure [x]
xs EquivFind x
ef = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntLikeSet x
c x
x -> if forall x. Coercible x Int => x -> IntLikeSet x -> Bool
ILS.member x
x IntLikeSet x
c then IntLikeSet x
c else forall x. IntLikeSet x -> IntLikeSet x -> IntLikeSet x
ILS.union (forall x. Coercible x Int => x -> EquivFind x -> IntLikeSet x
efEquivs x
x EquivFind x
ef) IntLikeSet x
c) forall x. IntLikeSet x
ILS.empty [x]
xs

-- | Find the root equivalent to the given key (if it exists).
efFindRoot :: Coercible x Int => x -> EquivFind x -> Maybe x
efFindRoot :: forall x. Coercible x Int => x -> EquivFind x -> Maybe x
efFindRoot x
x EquivFind x
ef = forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup x
x (forall x. EquivFind x -> IntLikeMap x x
efBwd EquivFind x
ef) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> if forall x a. Coercible x Int => x -> IntLikeMap x a -> Bool
ILM.member x
x (forall x. EquivFind x -> IntLikeMap x (IntLikeSet x)
efFwd EquivFind x
ef) then forall a. a -> Maybe a
Just x
x else forall a. Maybe a
Nothing

-- | Find the leaves equivalent to the given key (if they exist).
efFindLeaves :: Coercible x Int => x -> EquivFind x -> Maybe (IntLikeSet x)
efFindLeaves :: forall x.
Coercible x Int =>
x -> EquivFind x -> Maybe (IntLikeSet x)
efFindLeaves x
x EquivFind x
ef = forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup x
x (forall x. EquivFind x -> IntLikeMap x (IntLikeSet x)
efFwd EquivFind x
ef)

-- | Returns an EquivFind subset representing the given list of keys.
efSubset :: Coercible x Int => [x] -> EquivFind x -> EquivFind x
efSubset :: forall x. Coercible x Int => [x] -> EquivFind x -> EquivFind x
efSubset [x]
xs0 EquivFind x
ef0 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' EquivFind x -> x -> EquivFind x
go forall x. EquivFind x
efNew [x]
xs0 where
  go :: EquivFind x -> x -> EquivFind x
go (EquivFind IntLikeMap x (IntLikeSet x)
fwd1 IntLikeMap x x
bwd1) x
x =
    let r :: x
r = forall x. Coercible x Int => x -> EquivFind x -> x
efLookupRoot x
x EquivFind x
ef0
        ls :: IntLikeSet x
ls = forall x. Coercible x Int => x -> EquivFind x -> IntLikeSet x
efLookupLeaves x
r EquivFind x
ef0
    in forall x.
IntLikeMap x (IntLikeSet x) -> IntLikeMap x x -> EquivFind x
EquivFind (forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert x
r IntLikeSet x
ls IntLikeMap x (IntLikeSet x)
fwd1) (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntLikeMap x x
b x
l -> forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert x
l x
r IntLikeMap x x
b) IntLikeMap x x
bwd1 (forall x. Coercible x Int => IntLikeSet x -> [x]
ILS.toList IntLikeSet x
ls))

-- | Like 'efFindRoot' but returns same key if not found - does not guarantee presence in map.
efLookupRoot :: Coercible x Int => x -> EquivFind x -> x
efLookupRoot :: forall x. Coercible x Int => x -> EquivFind x -> x
efLookupRoot x
x = forall a. a -> Maybe a -> a
fromMaybe x
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup x
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. EquivFind x -> IntLikeMap x x
efBwd

-- | Like 'efFindLeaves' but returns empty set if not found - does not guarantee presence in map.
efLookupLeaves :: Coercible x Int => x -> EquivFind x -> IntLikeSet x
efLookupLeaves :: forall x. Coercible x Int => x -> EquivFind x -> IntLikeSet x
efLookupLeaves x
x = forall a. a -> Maybe a -> a
fromMaybe forall x. IntLikeSet x
ILS.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup x
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. EquivFind x -> IntLikeMap x (IntLikeSet x)
efFwd

-- | Returns the set of roots for the given set of keys, or an error with the first key
-- not found in the equiv.
efFindAll :: Coercible x Int => [x] -> EquivFind x -> Either x (IntLikeSet x)
efFindAll :: forall x.
Coercible x Int =>
[x] -> EquivFind x -> Either x (IntLikeSet x)
efFindAll [x]
xs EquivFind x
ef = IntLikeSet x -> [x] -> Either x (IntLikeSet x)
go forall x. IntLikeSet x
ILS.empty [x]
xs where
  go :: IntLikeSet x -> [x] -> Either x (IntLikeSet x)
go !IntLikeSet x
acc = \case
    [] -> forall a b. b -> Either a b
Right IntLikeSet x
acc
    x
y:[x]
ys ->
      case forall x. Coercible x Int => x -> EquivFind x -> Maybe x
efFindRoot x
y EquivFind x
ef of
        Maybe x
Nothing -> forall a b. a -> Either a b
Left x
y
        Just x
z -> IntLikeSet x -> [x] -> Either x (IntLikeSet x)
go (forall x. Coercible x Int => x -> IntLikeSet x -> IntLikeSet x
ILS.insert x
z IntLikeSet x
acc) [x]
ys

-- | Is the key in the equiv?
efMember :: Coercible x Int => x -> EquivFind x -> Bool
efMember :: forall x. Coercible x Int => x -> EquivFind x -> Bool
efMember x
x (EquivFind IntLikeMap x (IntLikeSet x)
fwd IntLikeMap x x
bwd) = forall x a. Coercible x Int => x -> IntLikeMap x a -> Bool
ILM.member x
x IntLikeMap x (IntLikeSet x)
fwd Bool -> Bool -> Bool
|| forall x a. Coercible x Int => x -> IntLikeMap x a -> Bool
ILM.member x
x IntLikeMap x x
bwd

-- | List all roots in the equiv.
efRoots :: Coercible x Int => EquivFind x -> [x]
efRoots :: forall x. Coercible x Int => EquivFind x -> [x]
efRoots = forall x a. Coercible x Int => IntLikeMap x a -> [x]
ILM.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. EquivFind x -> IntLikeMap x (IntLikeSet x)
efFwd

-- | List all leaves in the equiv.
efLeaves :: Coercible x Int => EquivFind x -> [x]
efLeaves :: forall x. Coercible x Int => EquivFind x -> [x]
efLeaves = forall x a. Coercible x Int => IntLikeMap x a -> [x]
ILM.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. EquivFind x -> IntLikeMap x x
efBwd

-- | List all members (roots and leaves) in the equiv.
efMembers :: Coercible x Int => EquivFind x -> [x]
efMembers :: forall x. Coercible x Int => EquivFind x -> [x]
efMembers EquivFind x
ef = forall x. Coercible x Int => EquivFind x -> [x]
efRoots EquivFind x
ef forall a. [a] -> [a] -> [a]
++ forall x. Coercible x Int => EquivFind x -> [x]
efLeaves EquivFind x
ef

-- | The result of trying to merge two keys, if you care.
data EquivMergeRes x =
    EquivMergeResMissing !x
  | EquivMergeResUnchanged !x
  | EquivMergeResChanged !x !(IntLikeSet x) !(EquivFind x)
  deriving stock (EquivMergeRes x -> EquivMergeRes x -> Bool
forall x. Eq x => EquivMergeRes x -> EquivMergeRes x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EquivMergeRes x -> EquivMergeRes x -> Bool
$c/= :: forall x. Eq x => EquivMergeRes x -> EquivMergeRes x -> Bool
== :: EquivMergeRes x -> EquivMergeRes x -> Bool
$c== :: forall x. Eq x => EquivMergeRes x -> EquivMergeRes x -> Bool
Eq, Int -> EquivMergeRes x -> ShowS
forall x. Show x => Int -> EquivMergeRes x -> ShowS
forall x. Show x => [EquivMergeRes x] -> ShowS
forall x. Show x => EquivMergeRes x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EquivMergeRes x] -> ShowS
$cshowList :: forall x. Show x => [EquivMergeRes x] -> ShowS
show :: EquivMergeRes x -> String
$cshow :: forall x. Show x => EquivMergeRes x -> String
showsPrec :: Int -> EquivMergeRes x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> EquivMergeRes x -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (EquivMergeRes x) x -> EquivMergeRes x
forall x x. EquivMergeRes x -> Rep (EquivMergeRes x) x
$cto :: forall x x. Rep (EquivMergeRes x) x -> EquivMergeRes x
$cfrom :: forall x x. EquivMergeRes x -> Rep (EquivMergeRes x) x
Generic)
  deriving anyclass (forall x. NFData x => EquivMergeRes x -> ()
forall a. (a -> ()) -> NFData a
rnf :: EquivMergeRes x -> ()
$crnf :: forall x. NFData x => EquivMergeRes x -> ()
NFData)

-- | Don't even think about it, it's got unsafe in the name.
efUnsafeMerge :: (Coercible x Int, Ord x) => x -> x -> EquivFind x -> (x, IntLikeSet x, EquivFind x)
efUnsafeMerge :: forall x.
(Coercible x Int, Ord x) =>
x -> x -> EquivFind x -> (x, IntLikeSet x, EquivFind x)
efUnsafeMerge x
ix x
jx (EquivFind IntLikeMap x (IntLikeSet x)
fwd IntLikeMap x x
bwd) =
  let loKey :: x
loKey = forall a. Ord a => a -> a -> a
min x
ix x
jx
      hiKey :: x
hiKey = forall a. Ord a => a -> a -> a
max x
ix x
jx
      hiSet :: IntLikeSet x
hiSet = forall x. Coercible x Int => x -> IntLikeSet x -> IntLikeSet x
ILS.insert x
hiKey (forall x a. Coercible x Int => x -> IntLikeMap x a -> a
ILM.partialLookup x
hiKey IntLikeMap x (IntLikeSet x)
fwd)
      finalFwd :: IntLikeMap x (IntLikeSet x)
finalFwd = forall x a.
Coercible x Int =>
(a -> a) -> x -> IntLikeMap x a -> IntLikeMap x a
ILM.adjust (IntLikeSet x
hiSet forall a. Semigroup a => a -> a -> a
<>) x
loKey (forall x a.
Coercible x Int =>
x -> IntLikeMap x a -> IntLikeMap x a
ILM.delete x
hiKey IntLikeMap x (IntLikeSet x)
fwd)
      finalBwd :: IntLikeMap x x
finalBwd = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
`ILM.insert` x
loKey)) IntLikeMap x x
bwd (forall x. Coercible x Int => IntLikeSet x -> [x]
ILS.toList IntLikeSet x
hiSet)
  in (x
loKey, IntLikeSet x
hiSet, forall x.
IntLikeMap x (IntLikeSet x) -> IntLikeMap x x -> EquivFind x
EquivFind IntLikeMap x (IntLikeSet x)
finalFwd IntLikeMap x x
finalBwd)

-- | Merge two keys (raw version).
efMergeInc :: (Coercible x Int, Ord x) => x -> x -> EquivFind x -> EquivMergeRes x
efMergeInc :: forall x.
(Coercible x Int, Ord x) =>
x -> x -> EquivFind x -> EquivMergeRes x
efMergeInc x
i x
j EquivFind x
ef =
  case forall x. Coercible x Int => x -> EquivFind x -> Maybe x
efFindRoot x
i EquivFind x
ef of
    Maybe x
Nothing -> forall x. x -> EquivMergeRes x
EquivMergeResMissing x
i
    Just x
ix ->
      case forall x. Coercible x Int => x -> EquivFind x -> Maybe x
efFindRoot x
j EquivFind x
ef of
        Maybe x
Nothing -> forall x. x -> EquivMergeRes x
EquivMergeResMissing x
j
        Just x
jx ->
          if x
ix forall a. Eq a => a -> a -> Bool
== x
jx
            then forall x. x -> EquivMergeRes x
EquivMergeResUnchanged x
ix
            else
              let (x
loKey, IntLikeSet x
hiSet, EquivFind x
ef') = forall x.
(Coercible x Int, Ord x) =>
x -> x -> EquivFind x -> (x, IntLikeSet x, EquivFind x)
efUnsafeMerge x
ix x
jx EquivFind x
ef
              in forall x. x -> IntLikeSet x -> EquivFind x -> EquivMergeRes x
EquivMergeResChanged x
loKey IntLikeSet x
hiSet EquivFind x
ef'

-- | Merge two keys (state version).
efMerge :: (Coercible x Int, Ord x) => x -> x -> State (EquivFind x) (Maybe (x, IntLikeSet x))
efMerge :: forall x.
(Coercible x Int, Ord x) =>
x -> x -> State (EquivFind x) (Maybe (x, IntLikeSet x))
efMerge x
i x
j = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall a b. (a -> b) -> a -> b
$ \EquivFind x
ef ->
  case forall x.
(Coercible x Int, Ord x) =>
x -> x -> EquivFind x -> EquivMergeRes x
efMergeInc x
i x
j EquivFind x
ef of
    EquivMergeResChanged x
loKey IntLikeSet x
hiSet EquivFind x
ef' -> (forall a. a -> Maybe a
Just (x
loKey, IntLikeSet x
hiSet), EquivFind x
ef')
    EquivMergeRes x
_ -> (forall a. Maybe a
Nothing, EquivFind x
ef)

-- | The result of trying to merge multiple keys, if you care.
data EquivMergeManyRes x =
    EquivMergeManyResEmpty
  | EquivMergeManyResEmbed !(EquivMergeRes x)
  deriving stock (EquivMergeManyRes x -> EquivMergeManyRes x -> Bool
forall x.
Eq x =>
EquivMergeManyRes x -> EquivMergeManyRes x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EquivMergeManyRes x -> EquivMergeManyRes x -> Bool
$c/= :: forall x.
Eq x =>
EquivMergeManyRes x -> EquivMergeManyRes x -> Bool
== :: EquivMergeManyRes x -> EquivMergeManyRes x -> Bool
$c== :: forall x.
Eq x =>
EquivMergeManyRes x -> EquivMergeManyRes x -> Bool
Eq, Int -> EquivMergeManyRes x -> ShowS
forall x. Show x => Int -> EquivMergeManyRes x -> ShowS
forall x. Show x => [EquivMergeManyRes x] -> ShowS
forall x. Show x => EquivMergeManyRes x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EquivMergeManyRes x] -> ShowS
$cshowList :: forall x. Show x => [EquivMergeManyRes x] -> ShowS
show :: EquivMergeManyRes x -> String
$cshow :: forall x. Show x => EquivMergeManyRes x -> String
showsPrec :: Int -> EquivMergeManyRes x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> EquivMergeManyRes x -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (EquivMergeManyRes x) x -> EquivMergeManyRes x
forall x x. EquivMergeManyRes x -> Rep (EquivMergeManyRes x) x
$cto :: forall x x. Rep (EquivMergeManyRes x) x -> EquivMergeManyRes x
$cfrom :: forall x x. EquivMergeManyRes x -> Rep (EquivMergeManyRes x) x
Generic)
  deriving anyclass (forall x. NFData x => EquivMergeManyRes x -> ()
forall a. (a -> ()) -> NFData a
rnf :: EquivMergeManyRes x -> ()
$crnf :: forall x. NFData x => EquivMergeManyRes x -> ()
NFData)

-- | The result of trying to merge multiple sets of keys, if you care.
data EquivMergeSetsRes x =
    EquivMergeSetsResEmptySet
  | EquivMergeSetsResMissing !x
  | EquivMergeSetsResUnchanged !(IntLikeSet x)
  | EquivMergeSetsResChanged !(IntLikeSet x) !(IntLikeSet x) !(EquivFind x)
  deriving stock (EquivMergeSetsRes x -> EquivMergeSetsRes x -> Bool
forall x.
Eq x =>
EquivMergeSetsRes x -> EquivMergeSetsRes x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EquivMergeSetsRes x -> EquivMergeSetsRes x -> Bool
$c/= :: forall x.
Eq x =>
EquivMergeSetsRes x -> EquivMergeSetsRes x -> Bool
== :: EquivMergeSetsRes x -> EquivMergeSetsRes x -> Bool
$c== :: forall x.
Eq x =>
EquivMergeSetsRes x -> EquivMergeSetsRes x -> Bool
Eq, Int -> EquivMergeSetsRes x -> ShowS
forall x. Show x => Int -> EquivMergeSetsRes x -> ShowS
forall x. Show x => [EquivMergeSetsRes x] -> ShowS
forall x. Show x => EquivMergeSetsRes x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EquivMergeSetsRes x] -> ShowS
$cshowList :: forall x. Show x => [EquivMergeSetsRes x] -> ShowS
show :: EquivMergeSetsRes x -> String
$cshow :: forall x. Show x => EquivMergeSetsRes x -> String
showsPrec :: Int -> EquivMergeSetsRes x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> EquivMergeSetsRes x -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (EquivMergeSetsRes x) x -> EquivMergeSetsRes x
forall x x. EquivMergeSetsRes x -> Rep (EquivMergeSetsRes x) x
$cto :: forall x x. Rep (EquivMergeSetsRes x) x -> EquivMergeSetsRes x
$cfrom :: forall x x. EquivMergeSetsRes x -> Rep (EquivMergeSetsRes x) x
Generic)
  deriving anyclass (forall x. NFData x => EquivMergeSetsRes x -> ()
forall a. (a -> ()) -> NFData a
rnf :: EquivMergeSetsRes x -> ()
$crnf :: forall x. NFData x => EquivMergeSetsRes x -> ()
NFData)

-- | Merge sets of keys (raw version).
efMergeSetsInc :: Coercible x Int => [IntLikeSet x] -> EquivFind x -> EquivMergeSetsRes x
efMergeSetsInc :: forall x.
Coercible x Int =>
[IntLikeSet x] -> EquivFind x -> EquivMergeSetsRes x
efMergeSetsInc [IntLikeSet x]
css0 EquivFind x
u0 = EquivMergeSetsRes x
res where
  res :: EquivMergeSetsRes x
res =
    case [IntLikeSet x]
css0 of
      [] -> forall x. IntLikeSet x -> EquivMergeSetsRes x
EquivMergeSetsResUnchanged forall x. IntLikeSet x
ILS.empty
      [IntLikeSet x]
_ -> forall {x}.
Coercible x Int =>
IntLikeSet x
-> IntLikeSet x
-> EquivFind x
-> [IntLikeSet x]
-> EquivMergeSetsRes x
go forall x. IntLikeSet x
ILS.empty forall x. IntLikeSet x
ILS.empty EquivFind x
u0 [IntLikeSet x]
css0
  go :: IntLikeSet x
-> IntLikeSet x
-> EquivFind x
-> [IntLikeSet x]
-> EquivMergeSetsRes x
go !IntLikeSet x
roots !IntLikeSet x
classRemapSet ef :: EquivFind x
ef@(EquivFind IntLikeMap x (IntLikeSet x)
fwd IntLikeMap x x
bwd) [IntLikeSet x]
css =
    case [IntLikeSet x]
css of
      [] ->
        let finalRoots :: IntLikeSet x
finalRoots = forall x y.
(Coercible x Int, Coercible y Int) =>
(x -> y) -> IntLikeSet x -> IntLikeSet y
ILS.map (forall x. Coercible x Int => x -> EquivFind x -> x
`efLookupRoot` EquivFind x
ef) IntLikeSet x
roots
        in if forall x. IntLikeSet x -> Bool
ILS.null IntLikeSet x
classRemapSet
          then forall x. IntLikeSet x -> EquivMergeSetsRes x
EquivMergeSetsResUnchanged IntLikeSet x
finalRoots
          else forall x.
IntLikeSet x -> IntLikeSet x -> EquivFind x -> EquivMergeSetsRes x
EquivMergeSetsResChanged IntLikeSet x
finalRoots IntLikeSet x
classRemapSet EquivFind x
ef
      IntLikeSet x
ds:[IntLikeSet x]
dss ->
        case forall x. Coercible x Int => IntLikeSet x -> [x]
ILS.toList IntLikeSet x
ds of
          [] -> IntLikeSet x
-> IntLikeSet x
-> EquivFind x
-> [IntLikeSet x]
-> EquivMergeSetsRes x
go IntLikeSet x
roots IntLikeSet x
classRemapSet EquivFind x
ef [IntLikeSet x]
dss
          [x]
zs -> case forall x.
Coercible x Int =>
[x] -> EquivFind x -> Either x (IntLikeSet x)
efFindAll [x]
zs EquivFind x
ef of
            Left x
x -> forall x. x -> EquivMergeSetsRes x
EquivMergeSetsResMissing x
x
            Right IntLikeSet x
xs ->
              let (x
loKey, IntLikeSet x
ys) = forall a. HasCallStack => Maybe a -> a
fromJust (forall x.
Coercible x Int =>
IntLikeSet x -> Maybe (x, IntLikeSet x)
ILS.minView IntLikeSet x
xs)
                  newRoots :: IntLikeSet x
newRoots = forall x. Coercible x Int => x -> IntLikeSet x -> IntLikeSet x
ILS.insert x
loKey IntLikeSet x
roots
                  hiSet :: IntLikeSet x
hiSet = forall (f :: * -> *) x.
Foldable f =>
f (IntLikeSet x) -> IntLikeSet x
ILS.unions (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x
y -> forall x. Coercible x Int => x -> IntLikeSet x -> IntLikeSet x
ILS.insert x
y (forall x. Coercible x Int => x -> EquivFind x -> IntLikeSet x
efLookupLeaves x
y EquivFind x
ef)) (forall x. Coercible x Int => IntLikeSet x -> [x]
ILS.toList IntLikeSet x
ys))
                  newClassRemapSet :: IntLikeSet x
newClassRemapSet = forall x. IntLikeSet x -> IntLikeSet x -> IntLikeSet x
ILS.union IntLikeSet x
hiSet IntLikeSet x
classRemapSet
                  newFwd :: IntLikeMap x (IntLikeSet x)
newFwd = forall x a.
Coercible x Int =>
(a -> a) -> x -> IntLikeMap x a -> IntLikeMap x a
ILM.adjust (forall x. IntLikeSet x -> IntLikeSet x -> IntLikeSet x
ILS.union IntLikeSet x
hiSet) x
loKey (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall x a.
Coercible x Int =>
x -> IntLikeMap x a -> IntLikeMap x a
ILM.delete) IntLikeMap x (IntLikeSet x)
fwd (forall x. Coercible x Int => IntLikeSet x -> [x]
ILS.toList IntLikeSet x
ys))
                  newBwd :: IntLikeMap x x
newBwd = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
`ILM.insert` x
loKey)) IntLikeMap x x
bwd (forall x. Coercible x Int => IntLikeSet x -> [x]
ILS.toList IntLikeSet x
hiSet)
                  newU :: EquivFind x
newU = forall x.
IntLikeMap x (IntLikeSet x) -> IntLikeMap x x -> EquivFind x
EquivFind IntLikeMap x (IntLikeSet x)
newFwd IntLikeMap x x
newBwd
              in IntLikeSet x
-> IntLikeSet x
-> EquivFind x
-> [IntLikeSet x]
-> EquivMergeSetsRes x
go IntLikeSet x
newRoots IntLikeSet x
newClassRemapSet EquivFind x
newU [IntLikeSet x]
dss

-- | Merge sets of keys (state version).
efMergeSets :: Coercible x Int => [IntLikeSet x] -> State (EquivFind x) (Maybe (IntLikeSet x, IntLikeSet x))
efMergeSets :: forall x.
Coercible x Int =>
[IntLikeSet x]
-> State (EquivFind x) (Maybe (IntLikeSet x, IntLikeSet x))
efMergeSets [IntLikeSet x]
css = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall a b. (a -> b) -> a -> b
$ \EquivFind x
ef ->
  case forall x.
Coercible x Int =>
[IntLikeSet x] -> EquivFind x -> EquivMergeSetsRes x
efMergeSetsInc [IntLikeSet x]
css EquivFind x
ef of
    EquivMergeSetsResChanged IntLikeSet x
roots IntLikeSet x
classRemapSet EquivFind x
ef' -> (forall a. a -> Maybe a
Just (IntLikeSet x
roots, IntLikeSet x
classRemapSet), EquivFind x
ef')
    EquivMergeSetsRes x
_ -> (forall a. Maybe a
Nothing, EquivFind x
ef)

-- | Are they compactible keys?
efCanCompact :: EquivFind x -> Bool
efCanCompact :: forall x. EquivFind x -> Bool
efCanCompact = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x a. IntLikeMap x a -> Bool
ILM.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. EquivFind x -> IntLikeMap x x
efBwd

-- | See 'efCompact' (this is the raw version).
efCompactInc :: Coercible x Int => EquivFind x -> (IntLikeMap x (IntLikeSet x), EquivFind x)
efCompactInc :: forall x.
Coercible x Int =>
EquivFind x -> (IntLikeMap x (IntLikeSet x), EquivFind x)
efCompactInc (EquivFind IntLikeMap x (IntLikeSet x)
origFwd IntLikeMap x x
origBwd) = (IntLikeMap x (IntLikeSet x), EquivFind x)
finalRes where
  finalRes :: (IntLikeMap x (IntLikeSet x), EquivFind x)
finalRes =
    let (IntLikeMap x (IntLikeSet x)
rootMap, IntLikeMap x (IntLikeSet x)
fwd') = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {x} {x}.
Coercible x Int =>
(IntLikeMap x (IntLikeSet x), IntLikeMap x (IntLikeSet x))
-> x -> (IntLikeMap x (IntLikeSet x), IntLikeMap x (IntLikeSet x))
go (forall x a. IntLikeMap x a
ILM.empty, IntLikeMap x (IntLikeSet x)
origFwd) (forall x a. IntLikeMap x a -> [a]
ILM.elems IntLikeMap x x
origBwd)
    in (IntLikeMap x (IntLikeSet x)
rootMap, forall x.
IntLikeMap x (IntLikeSet x) -> IntLikeMap x x -> EquivFind x
EquivFind IntLikeMap x (IntLikeSet x)
fwd' forall x a. IntLikeMap x a
ILM.empty)
  go :: (IntLikeMap x (IntLikeSet x), IntLikeMap x (IntLikeSet x))
-> x -> (IntLikeMap x (IntLikeSet x), IntLikeMap x (IntLikeSet x))
go p :: (IntLikeMap x (IntLikeSet x), IntLikeMap x (IntLikeSet x))
p@(IntLikeMap x (IntLikeSet x)
rootMap, IntLikeMap x (IntLikeSet x)
fwd) x
r =
    if forall x a. Coercible x Int => x -> IntLikeMap x a -> Bool
ILM.member x
r IntLikeMap x (IntLikeSet x)
rootMap
      then (IntLikeMap x (IntLikeSet x), IntLikeMap x (IntLikeSet x))
p
      else
        let xs :: IntLikeSet x
xs = forall x a. Coercible x Int => x -> IntLikeMap x a -> a
ILM.partialLookup x
r IntLikeMap x (IntLikeSet x)
fwd
        in (forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert x
r IntLikeSet x
xs IntLikeMap x (IntLikeSet x)
rootMap, if forall x. IntLikeSet x -> Bool
ILS.null IntLikeSet x
xs then IntLikeMap x (IntLikeSet x)
fwd else forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert x
r forall x. IntLikeSet x
ILS.empty IntLikeMap x (IntLikeSet x)
fwd)

-- | Removes leaves and returns map of root to deleted leaf.
efCompact :: Coercible x Int => State (EquivFind x) (IntLikeMap x (IntLikeSet x))
efCompact :: forall x.
Coercible x Int =>
State (EquivFind x) (IntLikeMap x (IntLikeSet x))
efCompact = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall x.
Coercible x Int =>
EquivFind x -> (IntLikeMap x (IntLikeSet x), EquivFind x)
efCompactInc

-- | See 'efRemoveAll' (this is the raw version).
efRemoveAllInc :: Coercible x Int => [x] -> EquivFind x -> (IntLikeMap x x, EquivFind x)
efRemoveAllInc :: forall x.
Coercible x Int =>
[x] -> EquivFind x -> (IntLikeMap x x, EquivFind x)
efRemoveAllInc [x]
xs (EquivFind IntLikeMap x (IntLikeSet x)
fwd0 IntLikeMap x x
bwd0) = (IntLikeMap x x
remapFinal, forall x.
IntLikeMap x (IntLikeSet x) -> IntLikeMap x x -> EquivFind x
EquivFind IntLikeMap x (IntLikeSet x)
fwdFinal IntLikeMap x x
bwdFinal) where
  (IntLikeMap x (IntLikeSet x)
fwdFinal, IntLikeMap x x
bwdFinal, IntLikeMap x x
remapFinal) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (IntLikeMap x (IntLikeSet x), IntLikeMap x x, IntLikeMap x x)
-> x
-> (IntLikeMap x (IntLikeSet x), IntLikeMap x x, IntLikeMap x x)
go (IntLikeMap x (IntLikeSet x)
fwd0, IntLikeMap x x
bwd0, forall x a. IntLikeMap x a
ILM.empty) [x]
xs
  go :: (IntLikeMap x (IntLikeSet x), IntLikeMap x x, IntLikeMap x x)
-> x
-> (IntLikeMap x (IntLikeSet x), IntLikeMap x x, IntLikeMap x x)
go tup :: (IntLikeMap x (IntLikeSet x), IntLikeMap x x, IntLikeMap x x)
tup@(IntLikeMap x (IntLikeSet x)
fwd, IntLikeMap x x
bwd, IntLikeMap x x
remap) x
x =
    case forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup x
x IntLikeMap x (IntLikeSet x)
fwd of
      -- Key is not root
      Maybe (IntLikeSet x)
Nothing -> case forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup x
x IntLikeMap x x
bwd of
        -- Key is missing, skip it
        Maybe x
Nothing -> (IntLikeMap x (IntLikeSet x), IntLikeMap x x, IntLikeMap x x)
tup
        -- Key is leaf, remove from both containers
        Just x
r ->
          let bwd' :: IntLikeMap x x
bwd' = forall x a.
Coercible x Int =>
x -> IntLikeMap x a -> IntLikeMap x a
ILM.delete x
x IntLikeMap x x
bwd
              fwd' :: IntLikeMap x (IntLikeSet x)
fwd' = forall x a.
Coercible x Int =>
(a -> a) -> x -> IntLikeMap x a -> IntLikeMap x a
ILM.adjust (forall x. Coercible x Int => x -> IntLikeSet x -> IntLikeSet x
ILS.delete x
x) x
r IntLikeMap x (IntLikeSet x)
fwd
          in (IntLikeMap x (IntLikeSet x)
fwd', IntLikeMap x x
bwd', IntLikeMap x x
remap)
      -- Key is root
      Just IntLikeSet x
leaves ->
        -- ensure the remapping is from ORIGINAL roots to new roots
        let origRoot :: x
origRoot = forall a. a -> Maybe a -> a
fromMaybe x
x (forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup x
x IntLikeMap x x
bwd0)
        in case forall x.
Coercible x Int =>
IntLikeSet x -> Maybe (x, IntLikeSet x)
ILS.minView IntLikeSet x
leaves of
          -- Singleton root, remove from fwd and remap
          Maybe (x, IntLikeSet x)
Nothing ->
            let fwd' :: IntLikeMap x (IntLikeSet x)
fwd' = forall x a.
Coercible x Int =>
x -> IntLikeMap x a -> IntLikeMap x a
ILM.delete x
x IntLikeMap x (IntLikeSet x)
fwd
                remap' :: IntLikeMap x x
remap' = forall x a.
Coercible x Int =>
x -> IntLikeMap x a -> IntLikeMap x a
ILM.delete x
origRoot IntLikeMap x x
remap
            in (IntLikeMap x (IntLikeSet x)
fwd', IntLikeMap x x
bwd, IntLikeMap x x
remap')
          -- Non-singleton root, rotate
          Just (x
y, IntLikeSet x
rest) ->
            let fwd' :: IntLikeMap x (IntLikeSet x)
fwd' = forall x a.
Coercible x Int =>
x -> IntLikeMap x a -> IntLikeMap x a
ILM.delete x
x (forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert x
y IntLikeSet x
rest IntLikeMap x (IntLikeSet x)
fwd)
                bwd' :: IntLikeMap x x
bwd' = forall x a.
Coercible x Int =>
x -> IntLikeMap x a -> IntLikeMap x a
ILM.delete x
y (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntLikeMap x x
m x
l -> forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert x
l x
y IntLikeMap x x
m) IntLikeMap x x
bwd (forall x. Coercible x Int => IntLikeSet x -> [x]
ILS.toList IntLikeSet x
rest))
                remap' :: IntLikeMap x x
remap' = forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert x
origRoot x
y IntLikeMap x x
remap
            in (IntLikeMap x (IntLikeSet x)
fwd', IntLikeMap x x
bwd', IntLikeMap x x
remap')

-- | Removes the given keys from the equiv map.
-- If a key is a leaf or singleton root, simply remove it.
-- If it is a root of a larger class, select the min leaf and make it root.
-- Returns a map of old roots to new roots (only those changed in the process -
-- possibly empty). If a key is not found, it is simply ignored.
efRemoveAll :: Coercible x Int => [x] -> State (EquivFind x) (IntLikeMap x x)
efRemoveAll :: forall x.
Coercible x Int =>
[x] -> State (EquivFind x) (IntLikeMap x x)
efRemoveAll = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x.
Coercible x Int =>
[x] -> EquivFind x -> (IntLikeMap x x, EquivFind x)
efRemoveAllInc

-- | Given root, add leaf. Requires that root be present in the map
-- and that leaf would be picked as a leaf. (Therefore, unsafe.)
-- Exposed for efficient merging.
efUnsafeAddLeafInc :: Coercible x Int => x -> x -> EquivFind x -> EquivFind x
efUnsafeAddLeafInc :: forall x. Coercible x Int => x -> x -> EquivFind x -> EquivFind x
efUnsafeAddLeafInc x
root x
leaf ef :: EquivFind x
ef@(EquivFind IntLikeMap x (IntLikeSet x)
fwd IntLikeMap x x
bwd) =
  let trueRoot :: x
trueRoot = forall x. Coercible x Int => x -> EquivFind x -> x
efLookupRoot x
root EquivFind x
ef
  in forall x.
IntLikeMap x (IntLikeSet x) -> IntLikeMap x x -> EquivFind x
EquivFind (forall x a.
Coercible x Int =>
(a -> a) -> x -> IntLikeMap x a -> IntLikeMap x a
ILM.adjust (forall x. Coercible x Int => x -> IntLikeSet x -> IntLikeSet x
ILS.insert x
leaf) x
trueRoot IntLikeMap x (IntLikeSet x)
fwd) (forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert x
leaf x
trueRoot IntLikeMap x x
bwd)