Skip to content
Browse files

Add 'minViewWithKey' and 'deleteFindMin'

  • Loading branch information...
1 parent f239a1f commit d36ef4c4fd0c358ed36c58c195e8845e20a12139 @bovinespirit committed
View
27 Data/EnumMapMap/Base.hs
@@ -69,6 +69,7 @@ import Prelude hiding (lookup,
import Control.DeepSeq (NFData(rnf))
import Data.Bits
+import Data.Maybe (fromMaybe)
import Data.Monoid (Monoid(..))
import GHC.Exts (Word(..), Int(..),
uncheckedShiftRL#, uncheckedShiftL#)
@@ -331,6 +332,13 @@ class (Eq k) => IsKey k where
-- > findMin empty -- ERROR, no minimal key
-- > findMin $ fromList [(K 1, "a", K 3, "b")] == (K 1, a)
findMin :: EnumMapMap k v -> (k, v)
+ -- | Retrieves the minimal (key,value) pair of the EnumMapMap, and the
+ -- EnumMapMap stripped of that element, or 'Nothing' if passed an empty map.
+ minViewWithKey :: EnumMapMap k v -> Maybe ((k, v), EnumMapMap k v)
+ deleteFindMin :: EnumMapMap k v -> ((k, v), EnumMapMap k v)
+ deleteFindMin =
+ fromMaybe(error "deleteFindMin: empty EnumMapMap has no minimal\
+ \ element") . minViewWithKey
-- | The (left-biased) union of two 'EnumMapMap's.
-- It prefers the first 'EnumMapMap' when duplicate keys are encountered.
union :: EnumMapMap k v -> EnumMapMap k v -> EnumMapMap k v
@@ -498,6 +506,25 @@ instance (Eq k, Enum k, IsKey t, HasSKey t) => IsKey (k :& t) where
go (Bin _ _ l' _) = go l'
go Nil = error "findMin: Nil"
+ minViewWithKey (KCC emm) =
+ goat emm >>= \(r, emm') -> return (r, KCC $ emm')
+ where
+ goat t =
+ case t of
+ Nil -> Nothing
+ Bin p m l r | m < 0 ->
+ case go r of
+ (result, r') ->
+ Just (result, binD p m l r')
+ _ -> Just (go t)
+ go (Bin p m l r) = case go l of
+ (result, l') -> (result, binD p m l' r)
+ go (Tip k y) = case minViewWithKey y of
+ Just ((t, v), y') ->
+ (((toEnum k) :& t, v), tip k y')
+ Nothing -> error "minViewWithKey: Nothing"
+ go Nil = error "minViewWithKey Nil"
+
union (KCC emm1) (KCC emm2) = KCC $ mergeWithKey' binD go id id emm1 emm2
where
go = \(Tip k1 x1) (Tip _ x2) -> tip k1 $ union x1 x2
View
16 Data/EnumMapMap/Lazy.hs
@@ -84,6 +84,8 @@ module Data.EnumMapMap.Lazy (
fromSet,
-- * Min/Max
findMin,
+ minViewWithKey,
+ deleteFindMin,
-- * Split/Join Keys
toK,
toS,
@@ -195,6 +197,20 @@ instance (Enum k, Eq k) => IsKey (K k) where
where go (Tip k v) = (K $ toEnum k, v)
go (Bin _ _ l' _) = go l'
go Nil = error "findMin: Nil"
+ minViewWithKey (KEC emm) =
+ goat emm >>= \(r, emm') -> return (r, KEC $ emm')
+ where
+ goat t =
+ case t of Nil -> Nothing
+ Bin p m l r | m < 0 ->
+ case go r of
+ (result, r') ->
+ Just (result, bin p m l r')
+ _ -> Just (go t)
+ go (Bin p m l r) = case go l of
+ (result, l') -> (result, bin p m l' r)
+ go (Tip k y) = ((K $ toEnum k, y), Nil)
+ go Nil = error "minViewWithKey Nil"
union (KEC emm1) (KEC emm2) = KEC $ mergeWithKey' Bin const id id emm1 emm2
unionWithKey f (KEC emm1) (KEC emm2) =
KEC $ mergeWithKey' Bin go id id emm1 emm2
View
16 Data/EnumMapMap/Strict.hs
@@ -84,6 +84,8 @@ module Data.EnumMapMap.Strict (
fromSet,
-- * Min/Max
findMin,
+ minViewWithKey,
+ deleteFindMin,
-- * Split/Join Keys
toK,
toS,
@@ -193,6 +195,20 @@ instance (Enum k, Eq k) => IsKey (K k) where
where go (Tip k v) = (K $ toEnum k, v)
go (Bin _ _ l' _) = go l'
go Nil = error "findMin: Nil"
+ minViewWithKey (KEC emm) =
+ goat emm >>= \(r, emm') -> return (r, KEC $ emm')
+ where
+ goat t =
+ case t of Nil -> Nothing
+ Bin p m l r | m < 0 ->
+ case go r of
+ (result, r') ->
+ Just (result, bin p m l r')
+ _ -> Just (go t)
+ go (Bin p m l r) = case go l of
+ (result, l') -> (result, bin p m l' r)
+ go (Tip k y) = ((K $ toEnum k, y), Nil)
+ go Nil = error "minViewWithKey Nil"
union (KEC emm1) (KEC emm2) = KEC $ mergeWithKey' Bin const id id emm1 emm2
unionWithKey f (KEC emm1) (KEC emm2) =
KEC $ mergeWithKey' Bin go id id emm1 emm2
View
4 Data/EnumMapSet.hs
@@ -50,7 +50,9 @@ module Data.EnumMapSet (
fromList,
keys,
-- * Min/Max
- findMin
+ findMin,
+ minView,
+ deleteFindMin
) where
import Data.EnumMapSet.Base as EMS
View
28 Data/EnumMapSet/Base.hs
@@ -45,6 +45,8 @@ module Data.EnumMapSet.Base (
keys,
-- * Min/Max
findMin,
+ minView,
+ deleteFindMin,
-- * Internals
EMS(..),
EnumMapMap(KSC),
@@ -63,6 +65,7 @@ import Prelude hiding (lookup,
import Data.Bits
import qualified Data.List as List
+import Data.Maybe (fromMaybe)
import GHC.Exts (Word(..), Int(..))
import GHC.Prim (indexInt8OffAddr#)
#include "MachDeps.h"
@@ -150,6 +153,23 @@ instance (Enum k, Eq k) => IsKey (S k) where
go (Bin _ _ l' _) = go l'
go Nil = error "findMin: Nil"
+ minViewWithKey (KSC ems) =
+ goat ems >>= (\(k, r) -> return ((S $ toEnum k, undefined), KSC r))
+ where
+ goat t =
+ case t of Nil -> Nothing
+ Bin p m l r | m < 0 ->
+ case go r of
+ (result, r') ->
+ Just (result, bin p m l r')
+ _ -> Just (go t)
+ go (Bin p m l r) = case go l of
+ (result, l') -> (result, bin p m l' r)
+ go (Tip kx bm) = case lowestBitSet bm of
+ bi -> (kx + bi,
+ tip kx (bm .&. complement
+ (bitmapOfSuffix bi)))
+ go Nil = error "minView Nil"
union (KSC ems1) (KSC ems2) = KSC $ go ems1 ems2
where
@@ -341,6 +361,14 @@ map f = fromList . List.map f . toList
findMin :: (IsKey k) => EnumMapSet k -> k
findMin = fst . EMM.findMin
+minView :: (IsKey k) => EnumMapSet k -> Maybe (k, EnumMapSet k)
+minView ems = EMM.minViewWithKey ems >>= \((k, _), ems') -> return (k, ems')
+
+deleteFindMin :: (IsKey k) => EnumMapSet k -> (k, EnumMapSet k)
+deleteFindMin =
+ fromMaybe (error "deleteFindMin: empty EnumMapSet has no minimal element")
+ . minView
+
union :: (IsKey k) => EnumMapSet k -> EnumMapSet k -> EnumMapSet k
union = EMM.union
View
2 README.md
@@ -64,7 +64,7 @@ TODO:
- Finish operations on subtrees: alter
- Check that Strict really is strict and Lazy really is lazy.
-- More functions - minView, mapMaybe, update, mergeWithKey, foldr'
+- More functions - mapMaybe, update, mergeWithKey, foldr'
- More benchmarks and optimisation
- More documentation
- More tests
View
73 test/EnumMapMapVsIntMap.hs
@@ -60,6 +60,15 @@ set2l3 s1 s2 = map (\s -> s :& s1 :& S s2)
set2l4 :: Int -> Int -> Int -> [Int] -> [Int :& Int :& Int :& S Int]
set2l4 s1 s2 s3 = map (\s -> s :& s1 :& s2 :& S s3)
+unKey1 :: K k -> k
+unKey1 (K k) = k
+unKey2 :: k1 :& K k2 -> k1
+unKey2 (k :& K _) = k
+unKey3 :: k1 :& k2 :& K k3 -> k1
+unKey3 (k :& _ :& K _) = k
+unKey4 :: k1 :& k2 :& k3 :& K k4 -> k1
+unKey4 (k :& _ :& _ :& K _) = k
+
-- | Run functions on an 'IntMap' and an 'EnumMapMap' created from list and check
-- that the results are equal
runProp :: Eq t =>
@@ -383,36 +392,68 @@ main = hspec $ do
describe "mapWithKey" $ do
let f k a = k + a
prop "Level 1" $
- runPropL (IM.mapWithKey f) (EMM.mapWithKey
- (\(K k) -> f k))
+ runPropL (IM.mapWithKey f) (EMM.mapWithKey (f . unKey1))
prop "Level 2" $
- runPropL2 (IM.mapWithKey f) (EMM.mapWithKey
- (\(k :& K _) -> f k))
+ runPropL2 (IM.mapWithKey f) (EMM.mapWithKey (f . unKey2))
prop "Level 3" $
- runPropL3 (IM.mapWithKey f) (EMM.mapWithKey
- (\(k :& _ :& K _) -> f k))
+ runPropL3 (IM.mapWithKey f) (EMM.mapWithKey (f . unKey3))
prop "Level 4" $
- runPropL4 (IM.mapWithKey f) (EMM.mapWithKey
- (\(k :& _ :& _ :& K _) -> f k))
+ runPropL4 (IM.mapWithKey f) (EMM.mapWithKey (f . unKey4))
describe "findMin" $ do
let go f (a, b) = (f a, b)
prop "Level 1" $ \list ->
(not $ L.null list) ==>
- runProp (IM.findMin) (go (\(K k) -> k) . EMM.findMin) list
+ runProp (IM.findMin) (go unKey1 . EMM.findMin) list
+ prop "Level 2" $ \k1 list ->
+ (not $ L.null list) ==>
+ runProp2 (IM.findMin) (go unKey2 . EMM.findMin) k1 list
+ prop "Level 3" $ \k1 k2 list ->
+ (not $ L.null list) ==>
+ runProp3 (IM.findMin) (go unKey3 . EMM.findMin) k1 k2 list
+ prop "Level 4" $ \k1 k2 k3 list ->
+ (not $ L.null list) ==>
+ runProp4 (IM.findMin) (go unKey4 . EMM.findMin) k1 k2 k3 list
+
+ describe "minViewWithKey" $ do
+ let goe _ Nothing = Nothing
+ goe f (Just ((k, v), emm)) = Just ((f k, v), EMM.toList emm)
+ goi _ Nothing = Nothing
+ goi f (Just ((k, v), im)) = Just ((k, v), f $ IM.toList im)
+ prop "Level 1" $
+ runProp (goi list2l1 . IM.minViewWithKey)
+ (goe unKey1 . EMM.minViewWithKey)
+ prop "Level 2" $ \k1 ->
+ runProp2 (goi (list2l2 k1) . IM.minViewWithKey)
+ (goe unKey2 . EMM.minViewWithKey) k1
+ prop "Level 3" $ \k1 k2 ->
+ runProp3 (goi (list2l3 k1 k2) . IM.minViewWithKey)
+ (goe unKey3 . EMM.minViewWithKey) k1 k2
+ prop "Level 4" $ \k1 k2 k3 ->
+ runProp4 (goi (list2l4 k1 k2 k3) . IM.minViewWithKey)
+ (goe unKey4 . EMM.minViewWithKey) k1 k2 k3
+
+ describe "deleteFindMin" $ do
+ let goe _ Nothing = Nothing
+ goe f (Just ((k, v), emm)) = Just ((f k, v), EMM.toList emm)
+ goi _ Nothing = Nothing
+ goi f (Just ((k, v), im)) = Just ((k, v), f $ IM.toList im)
+ prop "Level 1" $ \list ->
+ (not $ L.null list) ==>
+ runProp (goi list2l1 . IM.minViewWithKey)
+ (goe unKey1 . EMM.minViewWithKey) list
prop "Level 2" $ \k1 list ->
(not $ L.null list) ==>
- runProp2 (IM.findMin)
- (go (\(k :& K _) -> k) . EMM.findMin) k1 list
+ runProp2 (goi (list2l2 k1) . IM.minViewWithKey)
+ (goe unKey2 . EMM.minViewWithKey) k1 list
prop "Level 3" $ \k1 k2 list ->
(not $ L.null list) ==>
- runProp3 (IM.findMin)
- (go (\(k :& _ :& K _) -> k) . EMM.findMin) k1 k2 list
+ runProp3 (goi (list2l3 k1 k2) . IM.minViewWithKey)
+ (goe unKey3 . EMM.minViewWithKey) k1 k2 list
prop "Level 4" $ \k1 k2 k3 list ->
(not $ L.null list) ==>
- runProp4 (IM.findMin)
- (go (\(k :& _ :& _ :& K _) -> k) . EMM.findMin)
- k1 k2 k3 list
+ runProp4 (goi (list2l4 k1 k2 k3) . IM.minViewWithKey)
+ (goe unKey4 . EMM.minViewWithKey) k1 k2 k3 list
describe "union" $ do
prop "Level 1" $
View
30 test/EnumMapSetVsIntSet.hs
@@ -27,6 +27,13 @@ list2l2 k1 = map (\k -> k :& S k1)
list2l3 :: Int -> Int -> [Int] -> [Int :& Int :& S Int]
list2l3 k1 k2 = map (\k -> k :& k1 :& S k2)
+unKey1 :: S k -> k
+unKey1 (S k) = k
+unKey2 :: k1 :& S k2 -> k1
+unKey2 (k :& S _) = k
+unKey3 :: k1 :& k2 :& S k3 -> k1
+unKey3 (k :& _ :& S _) = k
+
runProp :: Eq t =>
(IS.IntSet -> t)
-> (TestSet1 -> t)
@@ -180,16 +187,27 @@ main = hspec $ do
describe "findMin" $ do
prop "Level 1" $ \list ->
(not $ L.null list) ==>
- runProp (IS.findMin)
- ((\(S k) -> k) . EMS.findMin) list
+ runProp (IS.findMin) (unKey1 . EMS.findMin) list
prop "Level 2" $ \k1 list ->
(not $ L.null list) ==>
- runProp2 (IS.findMin)
- ((\(k :& S _) -> k) . EMS.findMin) k1 list
+ runProp2 (IS.findMin) (unKey2 . EMS.findMin) k1 list
prop "Level 3" $ \k1 k2 list ->
(not $ L.null list) ==>
- runProp3 (IS.findMin)
- ((\(k :& _ :& S _) -> k) . EMS.findMin) k1 k2 list
+ runProp3 (IS.findMin) (unKey3 . EMS.findMin) k1 k2 list
+
+ describe "minView" $ do
+ let goe _ Nothing = Nothing
+ goe f (Just (k, ems)) = Just (f k, EMS.toList ems)
+ goi _ Nothing = Nothing
+ goi f (Just (k, is)) = Just (k, f $ IS.toList is)
+ prop "Level 1" $
+ runProp (goi list2l1 . IS.minView) (goe unKey1 . EMS.minView)
+ prop "Level 2" $ \k1 ->
+ runProp2 (goi (list2l2 k1) . IS.minView)
+ (goe unKey2 . EMS.minView) k1
+ prop "Level 3" $ \k1 k2 ->
+ runProp3 (goi (list2l3 k1 k2) . IS.minView)
+ (goe unKey3 . EMS.minView) k1 k2
describe "union" $ do
prop "Level 1" $
View
5 test/UnitEnumMapMap.hs
@@ -341,3 +341,8 @@ main =
it "throws an error when it is passed an empty EnumMapMap" $ do
evaluate (EMM.findMin (EMM.empty :: EnumMapMap (K Int) Int))
`shouldThrow` anyErrorCall
+
+ describe "deleteFindMin" $ do
+ it "throws an error when it is passed an empty EnumMapMap" $ do
+ evaluate (EMM.deleteFindMin (EMM.empty :: EnumMapMap (K Int) Int))
+ `shouldThrow` anyErrorCall

0 comments on commit d36ef4c

Please sign in to comment.
Something went wrong with that request. Please try again.