From 3641fc48bf93f4e3397d800c7d2057e325c34c7e Mon Sep 17 00:00:00 2001 From: Soumik Sarkar Date: Sat, 18 Jan 2025 11:27:15 +0530 Subject: [PATCH] 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. --- containers/src/Data/Map/Internal.hs | 4 ++-- containers/src/Data/Set/Internal.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/containers/src/Data/Map/Internal.hs b/containers/src/Data/Map/Internal.hs index 703a05a9f..11284c45b 100644 --- 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 index b432f1937..37fd406e3 100644 --- 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. --