Skip rebalancing in glue (#1094)

If two non-empty trees are balanced with respect to each other, removing one element from the larger does not take away that property.
haskell · Jan 18, 2025 · 3641fc4 · 3641fc4
1 parent efbdbc5
commit 3641fc4
Show file tree

Hide file tree

Showing 2 changed files with 4 additions and 4 deletions.
diff --git a/containers/src/Data/Map/Internal.hs b/containers/src/Data/Map/Internal.hs
@@ -4058,8 +4058,8 @@ glue :: Map k a -> Map k a -> Map k a
 glue Tip r = r
 glue l Tip = l
 glue l@(Bin sl kl xl ll lr) r@(Bin sr kr xr rl rr)
-  | sl > sr = let !(MaxView km m l') = maxViewSure kl xl ll lr in balanceR km m l' r
-  | otherwise = let !(MinView km m r') = minViewSure kr xr rl rr in balanceL km m l r'
+  | sl > sr = let !(MaxView km m l') = maxViewSure kl xl ll lr in Bin (sl+sr) km m l' r
+  | otherwise = let !(MinView km m r') = minViewSure kr xr rl rr in Bin (sl+sr) km m l r'
 
 data MinView k a = MinView !k a !(Map k a)
 data MaxView k a = MaxView !k a !(Map k a)

diff --git a/containers/src/Data/Set/Internal.hs b/containers/src/Data/Set/Internal.hs
@@ -1744,8 +1744,8 @@ glue :: Set a -> Set a -> Set a
 glue Tip r = r
 glue l Tip = l
 glue l@(Bin sl xl ll lr) r@(Bin sr xr rl rr)
-  | sl > sr = let !(m :*: l') = maxViewSure xl ll lr in balanceR m l' r
-  | otherwise = let !(m :*: r') = minViewSure xr rl rr in balanceL m l r'
+  | sl > sr = let !(m :*: l') = maxViewSure xl ll lr in Bin (sl+sr) m l' r
+  | otherwise = let !(m :*: r') = minViewSure xr rl rr in Bin (sl+sr) m l r'
 
 -- | \(O(\log n)\). Delete and find the minimal element.
 --