Quit using deleteFindMin and deleteFindMax
authorDavid Feuer <David.Feuer@gmail.com>
Tue, 6 Sep 2016 23:37:34 +0000 (19:37 -0400)
committerDavid Feuer <David.Feuer@gmail.com>
Wed, 7 Sep 2016 04:52:44 +0000 (00:52 -0400)
Stop using `deleteFindMin` or `deleteFindMax` internally, in both
`Data.Set` and `Data.Map`.

* The `deleteFindMin` and `deleteFindMax` functions are partial,
and also rather ugly. Reimplement `minView`, `minViewWithKey`, `glue`,
etc., using total functions. With manual call-pattern specialization,
this produces pretty core, and slight performance improvements as well.
I'm not sure why GHC doesn't do that specialization for us, but I
couldn't seem to convince it to.

* Add `lookupMin` and `lookupMax`, total versions of `findMin`
and `findMax`, to both `Data.Set` and `Data.Map`. Add `!?`, a
total version of `!`, to `Data.Map`.

Data/Map/Internal.hs
Data/Map/Lazy.hs
Data/Map/Strict.hs
Data/Map/Strict/Internal.hs
Data/Set.hs
Data/Set/Internal.hs
changelog.md
tests/map-properties.hs
tests/set-properties.hs

index 7d09eb9..ac6bbac 100644 (file)
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE PatternGuards #-}
 #if __GLASGOW_HASKELL__
 {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
 #endif
@@ -131,7 +132,7 @@ module Data.Map.Internal (
       Map(..)          -- instance Eq,Show,Read
 
     -- * Operators
-    , (!), (\\)
+    , (!), (!?), (\\)
 
     -- * Query
     , null
@@ -312,6 +313,8 @@ module Data.Map.Internal (
     , splitAt
 
     -- * Min\/Max
+    , lookupMin
+    , lookupMax
     , findMin
     , findMax
     , deleteMin
@@ -406,7 +409,7 @@ import Data.Coerce
 {--------------------------------------------------------------------
   Operators
 --------------------------------------------------------------------}
-infixl 9 !,\\ --
+infixl 9 !,!?,\\ --
 
 -- | /O(log n)/. Find the value at a key.
 -- Calls 'error' when the element can not be found.
@@ -417,14 +420,26 @@ infixl 9 !,\\ --
 (!) :: Ord k => Map k a -> k -> a
 (!) m k = find k m
 #if __GLASGOW_HASKELL__
-{-# INLINABLE (!) #-}
+{-# INLINE (!) #-}
+#endif
+
+-- | /O(log n)/. Find the value at a key.
+-- Returns 'Nothing' when the element can not be found.
+--
+-- prop> fromList [(5, 'a'), (3, 'b')] !? 1 == Nothing
+-- prop> fromList [(5, 'a'), (3, 'b')] !? 5 == Just 'a'
+
+(!?) :: Ord k => Map k a -> k -> Maybe a
+(!?) m k = lookup k m
+#if __GLASGOW_HASKELL__
+{-# INLINE (!?) #-}
 #endif
 
 -- | Same as 'difference'.
 (\\) :: Ord k => Map k a -> Map k b -> Map k a
 m1 \\ m2 = difference m1 m2
 #if __GLASGOW_HASKELL__
-{-# INLINABLE (\\) #-}
+{-# INLINE (\\) #-}
 #endif
 
 {--------------------------------------------------------------------
@@ -1554,25 +1569,56 @@ deleteAt !i t =
 {--------------------------------------------------------------------
   Minimal, Maximal
 --------------------------------------------------------------------}
+
+lookupMinSure :: k -> a -> Map k a -> (k, a)
+lookupMinSure k a Tip = (k, a)
+lookupMinSure _ _ (Bin _ k a l _) = lookupMinSure k a l
+
+-- | /O(log n)/. The minimal key of the map. Returns 'Nothing' if the map is empty.
+--
+-- > lookupMin (fromList [(5,"a"), (3,"b")]) == Just (3,"b")
+-- > findMin empty = Nothing
+--
+-- @since 0.5.9
+
+lookupMin :: Map k a -> Maybe (k,a)
+lookupMin Tip = Nothing
+lookupMin (Bin _ k x l _) = Just $! lookupMinSure k x l
+
 -- | /O(log n)/. The minimal key of the map. Calls 'error' if the map is empty.
 --
 -- > findMin (fromList [(5,"a"), (3,"b")]) == (3,"b")
 -- > findMin empty                            Error: empty map has no minimal element
 
 findMin :: Map k a -> (k,a)
-findMin (Bin _ kx x Tip _)  = (kx,x)
-findMin (Bin _ _  _ l _)    = findMin l
-findMin Tip                 = error "Map.findMin: empty map has no minimal element"
+findMin t
+  | Just r <- lookupMin t = r
+  | otherwise = error "Map.findMin: empty map has no minimal element"
 
 -- | /O(log n)/. The maximal key of the map. Calls 'error' if the map is empty.
 --
 -- > findMax (fromList [(5,"a"), (3,"b")]) == (5,"a")
 -- > findMax empty                            Error: empty map has no maximal element
 
+lookupMaxSure :: k -> a -> Map k a -> (k, a)
+lookupMaxSure k a Tip = (k, a)
+lookupMaxSure _ _ (Bin _ k a _ r) = lookupMaxSure k a r
+
+-- | /O(log n)/. The maximal key of the map. Returns 'Nothing' if the map is empty.
+--
+-- > lookupMax (fromList [(5,"a"), (3,"b")]) == Just (5,"a")
+-- > lookupMax empty = Nothing
+--
+-- @since 0.5.9
+
+lookupMax :: Map k a -> Maybe (k, a)
+lookupMax Tip = Nothing
+lookupMax (Bin _ k x _ r) = Just $! lookupMaxSure k x r
+
 findMax :: Map k a -> (k,a)
-findMax (Bin _ kx x _ Tip)  = (kx,x)
-findMax (Bin _ _  _ _ r)    = findMax r
-findMax Tip                 = error "Map.findMax: empty map has no maximal element"
+findMax t
+  | Just r <- lookupMax t = r
+  | otherwise = error "Map.findMax: empty map has no maximal element"
 
 -- | /O(log n)/. Delete the minimal key. Returns an empty map if the map is empty.
 --
@@ -1645,7 +1691,9 @@ updateMaxWithKey f (Bin _ kx x l r)    = balanceL kx x l (updateMaxWithKey f r)
 
 minViewWithKey :: Map k a -> Maybe ((k,a), Map k a)
 minViewWithKey Tip = Nothing
-minViewWithKey x   = Just $! deleteFindMin x
+minViewWithKey (Bin _ k x l r) =
+  case minViewSure k x l r of
+    MinView km xm t -> Just ((km, xm), t)
 
 -- | /O(log n)/. Retrieves the maximal (key,value) pair of the map, and
 -- the map stripped of that element, or 'Nothing' if passed an empty map.
@@ -1655,7 +1703,9 @@ minViewWithKey x   = Just $! deleteFindMin x
 
 maxViewWithKey :: Map k a -> Maybe ((k,a), Map k a)
 maxViewWithKey Tip = Nothing
-maxViewWithKey x   = Just $! deleteFindMax x
+maxViewWithKey (Bin _ k x l r) =
+  case maxViewSure k x l r of
+    MaxView km xm t -> Just ((km, xm), t)
 
 -- | /O(log n)/. Retrieves the value associated with minimal key of the
 -- map, and the map stripped of that element, or 'Nothing' if passed an
@@ -1665,8 +1715,9 @@ maxViewWithKey x   = Just $! deleteFindMax x
 -- > minView empty == Nothing
 
 minView :: Map k a -> Maybe (a, Map k a)
-minView Tip = Nothing
-minView x   = Just $! (first snd $ deleteFindMin x)
+minView t = case minViewWithKey t of
+              Nothing -> Nothing
+              Just ((_, x), t') -> Just (x, t')
 
 -- | /O(log n)/. Retrieves the value associated with maximal key of the
 -- map, and the map stripped of that element, or 'Nothing' if passed an
@@ -1676,13 +1727,9 @@ minView x   = Just $! (first snd $ deleteFindMin x)
 -- > maxView empty == Nothing
 
 maxView :: Map k a -> Maybe (a, Map k a)
-maxView Tip = Nothing
-maxView x   = Just $! (first snd $ deleteFindMax x)
-
--- Update the 1st component of a tuple (stricter version of
--- Control.Arrow.first)
-first :: (a -> b) -> (a,c) -> (b,c)
-first f (x,y) = (f x, y)
+maxView t = case maxViewWithKey t of
+              Nothing -> Nothing
+              Just ((_, x), t') -> Just (x, t')
 
 {--------------------------------------------------------------------
   Union.
@@ -3670,10 +3717,28 @@ link2 l@(Bin sizeL kx x lx rx) r@(Bin sizeR ky y ly ry)
 glue :: Map k a -> Map k a -> Map k a
 glue Tip r = r
 glue l Tip = l
-glue l r
-  | size l > size r = let ((km,m),l') = deleteFindMax l in balanceR km m l' r
-  | otherwise       = let ((km,m),r') = deleteFindMin r in balanceL km m l r'
+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'
+
+data MinView k a = MinView !k a !(Map k a)
+data MaxView k a = MaxView !k a !(Map k a)
 
+minViewSure :: k -> a -> Map k a -> Map k a -> MinView k a
+minViewSure = go
+  where
+    go k x Tip r = MinView k x r
+    go k x (Bin _ kl xl ll lr) r =
+      case go kl xl ll lr of
+        MinView km xm l' -> MinView km xm (balanceR k x l' r)
+
+maxViewSure :: k -> a -> Map k a -> Map k a -> MaxView k a
+maxViewSure = go
+  where
+    go k x l Tip = MaxView k x l
+    go k x l (Bin _ kr xr rl rr) =
+      case go kr xr rl rr of
+        MaxView km xm r' -> MaxView km xm (balanceL k x l r')
 
 -- | /O(log n)/. Delete and find the minimal element.
 --
@@ -3681,13 +3746,9 @@ glue l r
 -- > deleteFindMin                                            Error: can not return the minimal element of an empty map
 
 deleteFindMin :: Map k a -> ((k,a),Map k a)
-deleteFindMin t
-  = case t of
-      Bin _ k x Tip r -> ((k,x),r)
-      Bin _ k x l r   -> let !(km,l') = deleteFindMin l
-                             !t' = balanceR k x l' r
-                         in (km, t')
-      Tip             -> (error "Map.deleteFindMin: can not return the minimal element of an empty map", Tip)
+deleteFindMin t = case minViewWithKey t of
+  Nothing -> (error "Map.deleteFindMin: can not return the minimal element of an empty map", Tip)
+  Just res -> res
 
 -- | /O(log n)/. Delete and find the maximal element.
 --
@@ -3695,14 +3756,9 @@ deleteFindMin t
 -- > deleteFindMax empty                                      Error: can not return the maximal element of an empty map
 
 deleteFindMax :: Map k a -> ((k,a),Map k a)
-deleteFindMax t
-  = case t of
-      Bin _ k x l Tip -> ((k,x),l)
-      Bin _ k x l r   -> let !(km,r') = deleteFindMax r
-                             !t' = balanceL k x l r'
-                         in (km, t')
-      Tip             -> (error "Map.deleteFindMax: can not return the maximal element of an empty map", Tip)
-
+deleteFindMax t = case maxViewWithKey t of
+  Nothing -> (error "Map.deleteFindMax: can not return the maximal element of an empty map", Tip)
+  Just res -> res
 
 {--------------------------------------------------------------------
   [balance l x r] balances two trees with value x.
index 966b442..00ff3f4 100644 (file)
@@ -66,7 +66,7 @@ module Data.Map.Lazy (
     Map              -- instance Eq,Show,Read
 
     -- * Operators
-    , (!), (\\)
+    , (!), (!?), (\\)
 
     -- * Query
     , null
@@ -212,6 +212,8 @@ module Data.Map.Lazy (
     , splitAt
 
     -- * Min\/Max
+    , lookupMin
+    , lookupMax
     , findMin
     , findMax
     , deleteMin
index e4684cf..fd77f84 100644 (file)
@@ -74,7 +74,7 @@ module Data.Map.Strict
     Map              -- instance Eq,Show,Read
 
     -- * Operators
-    , (!), (\\)
+    , (!), (!?), (\\)
 
     -- * Query
     , null
@@ -221,6 +221,8 @@ module Data.Map.Strict
     , splitAt
 
     -- * Min\/Max
+    , lookupMin
+    , lookupMax
     , findMin
     , findMax
     , deleteMin
index c8882a0..7a5abf6 100644 (file)
@@ -88,7 +88,7 @@ module Data.Map.Strict.Internal
     Map(..)          -- instance Eq,Show,Read
 
     -- * Operators
-    , (!), (\\)
+    , (!), (!?), (\\)
 
     -- * Query
     , null
@@ -273,6 +273,8 @@ module Data.Map.Strict.Internal
     , splitAt
 
     -- * Min\/Max
+    , lookupMin
+    , lookupMax
     , findMin
     , findMax
     , deleteMin
@@ -312,6 +314,7 @@ import Data.Map.Internal
   , merge
   , mergeA
   , (!)
+  , (!?)
   , (\\)
   , assocs
   , atKeyImpl
@@ -363,6 +366,8 @@ import Data.Map.Internal
   , lookupIndex
   , lookupLE
   , lookupLT
+  , lookupMin
+  , lookupMax
   , mapKeys
   , mapKeysMonotonic
   , maxView
index 7610b8f..573d003 100644 (file)
@@ -121,6 +121,8 @@ module Data.Set (
             , fold
 
             -- * Min\/Max
+            , lookupMin
+            , lookupMax
             , findMin
             , findMax
             , deleteMin
index c0b6160..fa00711 100644 (file)
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE PatternGuards #-}
 #if __GLASGOW_HASKELL__
 {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
 #endif
@@ -182,6 +183,8 @@ module Data.Set.Internal (
             , fold
 
             -- * Min\/Max
+            , lookupMin
+            , lookupMax
             , findMin
             , findMax
             , deleteMin
@@ -603,17 +606,46 @@ isSubsetOfX (Bin _ x l r) t
 {--------------------------------------------------------------------
   Minimal, Maximal
 --------------------------------------------------------------------}
+
+-- We perform call-pattern specialization manually on lookupMin
+-- and lookupMax. Otherwise, GHC doesn't seem to do it, which is
+-- unfortunate if, for example, someone uses findMin or findMax.
+
+lookupMinSure :: a -> Set a -> a
+lookupMinSure x Tip = x
+lookupMinSure _ (Bin _ x l _) = lookupMinSure x l
+
+-- | /O(log n)/. The minimal element of a set.
+--
+-- @since 0.5.9
+
+lookupMin :: Set a -> Maybe a
+lookupMin Tip = Nothing
+lookupMin (Bin _ x l _) = Just $! lookupMinSure x l
+
 -- | /O(log n)/. The minimal element of a set.
 findMin :: Set a -> a
-findMin (Bin _ x Tip _) = x
-findMin (Bin _ _ l _)   = findMin l
-findMin Tip             = error "Set.findMin: empty set has no minimal element"
+findMin t
+  | Just r <- lookupMin t = r
+  | otherwise = error "Set.findMin: empty set has no minimal element"
+
+lookupMaxSure :: a -> Set a -> a
+lookupMaxSure x Tip = x
+lookupMaxSure _ (Bin _ x _ r) = lookupMaxSure x r
+
+-- | /O(log n)/. The maximal element of a set.
+--
+-- @since 0.5.9
+
+lookupMax :: Set a -> Maybe a
+lookupMax Tip = Nothing
+lookupMax (Bin _ x _ r) = Just $! lookupMaxSure x r
 
 -- | /O(log n)/. The maximal element of a set.
 findMax :: Set a -> a
-findMax (Bin _ x _ Tip)  = x
-findMax (Bin _ _ _ r)    = findMax r
-findMax Tip              = error "Set.findMax: empty set has no maximal element"
+findMax t
+  | Just r <- lookupMax t = r
+  | otherwise = error "Set.findMax: empty set has no maximal element"
 
 -- | /O(log n)/. Delete the minimal element. Returns an empty set if the set is empty.
 deleteMin :: Set a -> Set a
@@ -1364,9 +1396,9 @@ merge l@(Bin sizeL x lx rx) r@(Bin sizeR y ly ry)
 glue :: Set a -> Set a -> Set a
 glue Tip r = r
 glue l Tip = l
-glue l r
-  | size l > size r = let (m,l') = deleteFindMax l in balanceR m l' r
-  | otherwise       = let (m,r') = deleteFindMin r in balanceL m l r'
+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'
 
 -- | /O(log n)/. Delete and find the minimal element.
 --
@@ -1374,32 +1406,44 @@ glue l r
 
 deleteFindMin :: Set a -> (a,Set a)
 deleteFindMin t
-  = case t of
-      Bin _ x Tip r -> (x,r)
-      Bin _ x l r   -> let (xm,l') = deleteFindMin l in (xm,balanceR x l' r)
-      Tip           -> (error "Set.deleteFindMin: can not return the minimal element of an empty set", Tip)
+  | Just r <- minView t = r
+  | otherwise = (error "Set.deleteFindMin: can not return the minimal element of an empty set", Tip)
 
 -- | /O(log n)/. Delete and find the maximal element.
 --
 -- > deleteFindMax set = (findMax set, deleteMax set)
 deleteFindMax :: Set a -> (a,Set a)
 deleteFindMax t
-  = case t of
-      Bin _ x l Tip -> (x,l)
-      Bin _ x l r   -> let (xm,r') = deleteFindMax r in (xm,balanceL x l r')
-      Tip           -> (error "Set.deleteFindMax: can not return the maximal element of an empty set", Tip)
+  | Just r <- maxView t = r
+  | otherwise = (error "Set.deleteFindMax: can not return the maximal element of an empty set", Tip)
+
+minViewSure :: a -> Set a -> Set a -> StrictPair a (Set a)
+minViewSure = go
+  where
+    go x Tip r = x :*: r
+    go x (Bin _ xl ll lr) r =
+      case go xl ll lr of
+        xm :*: l' -> xm :*: balanceR x l' r
 
 -- | /O(log n)/. Retrieves the minimal key of the set, and the set
 -- stripped of that element, or 'Nothing' if passed an empty set.
 minView :: Set a -> Maybe (a, Set a)
 minView Tip = Nothing
-minView x = Just (deleteFindMin x)
+minView (Bin _ x l r) = Just $! toPair $ minViewSure x l r
+
+maxViewSure :: a -> Set a -> Set a -> StrictPair a (Set a)
+maxViewSure = go
+  where
+    go x l Tip = x :*: l
+    go x l (Bin _ xr rl rr) =
+      case go xr rl rr of
+        xm :*: r' -> xm :*: balanceL x l r'
 
 -- | /O(log n)/. Retrieves the maximal key of the set, and the set
 -- stripped of that element, or 'Nothing' if passed an empty set.
 maxView :: Set a -> Maybe (a, Set a)
 maxView Tip = Nothing
-maxView x = Just (deleteFindMax x)
+maxView (Bin _ x l r) = Just $! toPair $ maxViewSure x l r
 
 {--------------------------------------------------------------------
   [balance x l r] balances two trees with value x.
index 197e5b4..f040035 100644 (file)
 * Plug space leaks in `Data.Map.Lazy.fromAscList` and
  `Data.Map.Lazy.fromDescList` by manually inlining constant functions.
 
+* Add `lookupMin` and `lookupMax` to `Data.Set` and `Data.Map` as total
+alternatives to `findMin` and `findMax`.
+
+* Add `!?` to `Data.Map` as a total alternative to `!`.
+
+* Avoid using `deleteFindMin` and `deleteFindMax` internally, preferring
+total functions instead. New implementations of said functions lead to slight
+performance improvements overall.
+
 ## 0.5.8.1 *Aug 2016*
 
 ### General package changes
index 703f88f..59522f3 100644 (file)
@@ -222,6 +222,8 @@ main = defaultMain
          , testProperty "take"                 prop_take
          , testProperty "drop"                 prop_drop
          , testProperty "splitAt"              prop_splitAt
+         , testProperty "lookupMin"            prop_lookupMin
+         , testProperty "lookupMax"            prop_lookupMax
          ]
 
 {--------------------------------------------------------------------
@@ -961,6 +963,12 @@ prop_deleteMin t = valid $ deleteMin $ deleteMin t
 prop_deleteMax :: UMap -> Bool
 prop_deleteMax t = valid $ deleteMax $ deleteMax t
 
+prop_lookupMin :: IMap -> Property
+prop_lookupMin m = lookupMin m === (fst <$> minViewWithKey m)
+
+prop_lookupMax :: IMap -> Property
+prop_lookupMax m = lookupMax m === (fst <$> maxViewWithKey m)
+
 ----------------------------------------------------------------
 
 prop_split :: Int -> UMap -> Bool
index 5a48397..d9aea92 100644 (file)
@@ -67,6 +67,8 @@ main = defaultMain [ testCase "lookupLT" test_lookupLT
                    , testProperty "prop_isSubsetOf" prop_isSubsetOf
                    , testProperty "prop_isSubsetOf2" prop_isSubsetOf2
                    , testProperty "prop_size" prop_size
+                   , testProperty "prop_lookupMax" prop_lookupMax
+                   , testProperty "prop_lookupMin" prop_lookupMin
                    , testProperty "prop_findMax" prop_findMax
                    , testProperty "prop_findMin" prop_findMin
                    , testProperty "prop_ord" prop_ord
@@ -493,6 +495,12 @@ prop_findMax s = not (null s) ==> findMax s == maximum (toList s)
 prop_findMin :: Set Int -> Property
 prop_findMin s = not (null s) ==> findMin s == minimum (toList s)
 
+prop_lookupMin :: Set Int -> Property
+prop_lookupMin m = lookupMin m === (fst <$> minView m)
+
+prop_lookupMax :: Set Int -> Property
+prop_lookupMax m = lookupMax m === (fst <$> maxView m)
+
 prop_ord :: TwoSets -> Bool
 prop_ord (TwoSets s1 s2) = s1 `compare` s2 == toList s1 `compare` toList s2