Permalink
Browse files

'delete' can now delete subtrees

  • Loading branch information...
1 parent a4f6dee commit 59311f6f711f7e4a5155adbbab9ff7f3dc8dcd45 @bovinespirit committed Oct 22, 2012
Showing with 81 additions and 83 deletions.
  1. +9 −8 Data/EnumMapMap/Base.hs
  2. +23 −34 Data/EnumMapMap/Lazy.hs
  3. +23 −34 Data/EnumMapMap/Strict.hs
  4. +19 −5 Data/EnumMapSet/Base.hs
  5. +7 −2 test/UnitEnumMapMap.hs
@@ -43,6 +43,7 @@ module Data.EnumMapMap.Base(
Prefix,
Mask,
Nat,
+ Key,
intFromNat,
shiftRL,
shiftLL,
@@ -166,12 +167,16 @@ class SubKey k1 k2 v where
-- > lookup (3 :& K 2) emm2 == Just $ fromList [(K 1, "a"), (K 4, "a")]
--
lookup :: (IsKey k1, IsKey k2) =>
- k1 -> EnumMapMap k2 v -> Maybe (Result k1 k2 v)
+ k1 -> EnumMapMap k2 v -> Maybe (Result k1 k2 v)
+ -- | Remove a key and it's value from the 'EnumMapMap'. If the key is not
+ -- present the original 'EnumMapMap' is returned.
+ delete :: (IsKey k1, IsKey k2) =>
+ k1 -> EnumMapMap k2 v -> EnumMapMap k2 v
instance (Enum k, IsKey t1, IsKey t2, SubKey t1 t2 v) =>
SubKey (k :& t1) (k :& t2) v where
type Result (k :& t1) (k :& t2) v = Result t1 t2 v
- lookup (key' :& nxt) (KCC emm) = key `seq` go emm
+ lookup !(key' :& nxt) (KCC emm) = key `seq` go emm
where
go (Bin _ m l r)
| zero key m = go l
@@ -182,6 +187,8 @@ instance (Enum k, IsKey t1, IsKey t2, SubKey t1 t2 v) =>
False -> Nothing
go Nil = Nothing
key = fromEnum key'
+ delete !(key :& nxt) (KCC emm) =
+ KCC $ alter_ (delete nxt) (fromEnum key) emm
class HasSKey k where
type Skey k :: *
@@ -271,9 +278,6 @@ class (Eq k) => IsKey k where
-- | Insert with a combining function.
insertWithKey :: (k -> v -> v -> v)
-> k -> v -> EnumMapMap k v -> EnumMapMap k v
- -- | Remove a key and it's value from the 'EnumMapMap'. If the key is not
- -- present the original 'EnumMapMap' is returned.
- delete :: k -> EnumMapMap k v -> EnumMapMap k v
-- | The expression (@'alter' f k emm@) alters the value at @k@, or absence thereof.
-- 'alter' can be used to insert, delete, or update a value in an 'EnumMapMap'.
alter :: (Maybe v -> Maybe v) -> k -> EnumMapMap k v -> EnumMapMap k v
@@ -406,9 +410,6 @@ instance (Eq k, Enum k, IsKey t, HasSKey t) => IsKey (k :& t) where
where
go = insertWithKey (\_ -> f k) nxt val
- delete !(key :& nxt) (KCC emm) =
- KCC $ alter_ (delete nxt) (fromEnum key) emm
-
alter f !(key :& nxt) (KCC emm) =
KCC $ alter_ (alter f nxt) (fromEnum key) emm
@@ -170,17 +170,6 @@ instance (Enum k, Eq k) => IsKey (K k) where
Nil -> Tip key val
key = fromEnum key'
- delete !(K key') (KEC emm) = KEC $ go emm
- where
- go t = case t of
- Bin p m l r | nomatch key p m -> t
- | zero key m -> bin p m (go l) r
- | otherwise -> bin p m l (go r)
- Tip ky _ | key == ky -> Nil
- | otherwise -> t
- Nil -> Nil
- key = fromEnum key'
-
alter f !(K key') (KEC emm) = KEC $ go emm
where
go t = case t of
@@ -286,29 +275,29 @@ instance IsSplit (k :& t) Z where
instance (Enum k1, k1 ~ k2) => SubKey (K k1) (k2 :& t2) v where
type Result (K k1) (k2 :& t2) v = EnumMapMap t2 v
- lookup (K key') (KCC emm) = key `seq` go emm
- where
- go (Bin _ m l r)
- | zero key m = go l
- | otherwise = go r
- go (Tip kx x)
- = case kx == key of
- True -> Just x
- False -> Nothing
- go Nil = Nothing
- key = fromEnum key'
+ lookup (K key') (KCC emm) = lookup_ (fromEnum key') emm
+ delete !(K key') (KCC emm) = KCC $ delete_ (fromEnum key') emm
instance (Enum k) => SubKey (K k) (K k) v where
type Result (K k) (K k) v = v
- lookup (K key') (KEC emm) = key `seq` go emm
- where
- go (Bin _ m l r)
- | zero key m = go l
- | otherwise = go r
- go (Tip kx x)
- = case kx == key of
- True -> Just x
- False -> Nothing
- go Nil = Nothing
- key = fromEnum key'
-
+ lookup (K key') (KEC emm) = lookup_ (fromEnum key') emm
+ delete !(K key') (KEC emm) = KEC $ delete_ (fromEnum key') emm
+
+lookup_ :: Key -> EMM k v -> Maybe v
+lookup_ !key emm =
+ case emm of
+ Bin _ m l r
+ | zero key m -> lookup_ key l
+ | otherwise -> lookup_ key r
+ Tip kx x -> if kx == key then Just x else Nothing
+ Nil -> Nothing
+
+delete_ :: Key -> EMM k v -> EMM k v
+delete_ !key emm =
+ case emm of
+ Bin p m l r | nomatch key p m -> emm
+ | zero key m -> bin p m (delete_ key l) r
+ | otherwise -> bin p m l (delete_ key r)
+ Tip ky _ | key == ky -> Nil
+ | otherwise -> emm
+ Nil -> Nil
@@ -171,17 +171,6 @@ instance (Enum k, Eq k) => IsKey (K k) where
Nil -> Tip key val
key = fromEnum key'
- delete !(K key') (KEC emm) = KEC $ go emm
- where
- go t = case t of
- Bin p m l r | nomatch key p m -> t
- | zero key m -> bin p m (go l) r
- | otherwise -> bin p m l (go r)
- Tip ky _ | key == ky -> Nil
- | otherwise -> t
- Nil -> Nil
- key = fromEnum key'
-
alter f !(K key') (KEC emm) = KEC $ go emm
where
go t = case t of
@@ -287,29 +276,29 @@ instance IsSplit (k :& t) Z where
instance (Enum k1, k1 ~ k2) => SubKey (K k1) (k2 :& t2) v where
type Result (K k1) (k2 :& t2) v = EnumMapMap t2 v
- lookup (K key') (KCC emm) = key `seq` go emm
- where
- go (Bin _ m l r)
- | zero key m = go l
- | otherwise = go r
- go (Tip kx x)
- = case kx == key of
- True -> Just x
- False -> Nothing
- go Nil = Nothing
- key = fromEnum key'
+ lookup (K key') (KCC emm) = lookup_ (fromEnum key') emm
+ delete !(K key') (KCC emm) = KCC $ delete_ (fromEnum key') emm
instance (Enum k) => SubKey (K k) (K k) v where
type Result (K k) (K k) v = v
- lookup (K key') (KEC emm) = key `seq` go emm
- where
- go (Bin _ m l r)
- | zero key m = go l
- | otherwise = go r
- go (Tip kx x)
- = case kx == key of
- True -> Just x
- False -> Nothing
- go Nil = Nothing
- key = fromEnum key'
-
+ lookup (K key') (KEC emm) = lookup_ (fromEnum key') emm
+ delete !(K key') (KEC emm) = KEC $ delete_ (fromEnum key') emm
+
+lookup_ :: Key -> EMM k v -> Maybe v
+lookup_ !key emm =
+ case emm of
+ Bin _ m l r
+ | zero key m -> lookup_ key l
+ | otherwise -> lookup_ key r
+ Tip kx x -> if kx == key then Just x else Nothing
+ Nil -> Nothing
+
+delete_ :: Key -> EMM k v -> EMM k v
+delete_ !key emm =
+ case emm of
+ Bin p m l r | nomatch key p m -> emm
+ | zero key m -> bin p m (delete_ key l) r
+ | otherwise -> bin p m l (delete_ key r)
+ Tip ky _ | key == ky -> Nil
+ | otherwise -> emm
+ Nil -> Nil
@@ -144,10 +144,6 @@ instance (Enum k, Eq k) => IsKey (S k) where
= key `seq` KSC $ insertBM (prefixOf key) (bitmapOf key) ems
where key = fromEnum key'
- delete (S key') (KSC ems)
- = key `seq` KSC $ deleteBM (prefixOf key) (bitmapOf key) ems
- where key = fromEnum key'
-
foldrWithKey f init (KSC ems)
= case ems of Bin _ m l r | m < 0 -> go (go init l) r
| otherwise -> go (go init r) l
@@ -321,7 +317,8 @@ singleton !key = EMM.singleton key ()
insert :: (IsKey k) => k -> EnumMapSet k -> EnumMapSet k
insert !key = EMM.insert key ()
-delete :: (IsKey k) => k -> EnumMapSet k -> EnumMapSet k
+delete :: (EMM.SubKey k1 k2 (), IsKey k1, IsKey k2) =>
+ k1 -> EnumMapSet k2 -> EnumMapSet k2
delete = EMM.delete
-- This function has not been optimised in any way.
@@ -383,6 +380,23 @@ instance (Enum k1, k1 ~ k2) => EMM.SubKey (S k1) (k2 :& t2) () where
False -> Nothing
go EMM.Nil = Nothing
key = fromEnum key'
+ delete (S key') (EMM.KCC emm) = key `seq` EMM.KCC $ go emm
+ where
+ go t = case t of
+ EMM.Bin p m l r | nomatch key p m -> t
+ | zero key m -> EMM.bin p m (go l) r
+ | otherwise -> EMM.bin p m l (go r)
+ EMM.Tip ky _ | key == ky -> EMM.Nil
+ | otherwise -> t
+ EMM.Nil -> EMM.Nil
+ key = fromEnum key'
+
+instance (Enum k) => EMM.SubKey (S k) (S k) () where
+ type Result (S k) (S k) () = Bool
+ lookup = undefined
+ delete !(S key') (KSC ems) =
+ key `seq` KSC $ deleteBM (prefixOf key) (bitmapOf key) ems
+ where key = fromEnum key'
{---------------------------------------------------------------------
Helper functions
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, TypeOperators #-}
+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
import Control.Monad (liftM, liftM2)
@@ -204,7 +204,12 @@ main =
EMM.fromList [(2 :& K 3, 1), (2 :& K 4, 48)]
describe "delete" $ do
- prop "leaves no empty subtrees" $ \k l ->
+ describe "leaves no empty subtrees" $ do
+ prop "Full key" $ \(k :: ID3 :& ID2 :& K ID1) l ->
+ not $ EMM.emptySubTrees $ EMM.delete k $ (EMM.fromList l :: TestEmm3)
+ prop "2 dimensional key" $ \(k :: ID3 :& K ID2) l ->
+ not $ EMM.emptySubTrees $ EMM.delete k $ (EMM.fromList l :: TestEmm3)
+ prop "1 dimensional key" $ \(k :: K ID3) l ->
not $ EMM.emptySubTrees $ EMM.delete k $ (EMM.fromList l :: TestEmm3)
describe "alter" $ do

0 comments on commit 59311f6

Please sign in to comment.