Skip to content

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
...
  • 2 commits
  • 9 files changed
  • 0 commit comments
  • 1 contributor
Commits on Dec 03, 2012
@bovinespirit Version bump to 0.5.0 5b2e163
Commits on Dec 05, 2012
@bovinespirit Add 'findMin' c5e7224
View
18 Data/EnumMapMap/Base.hs
@@ -326,6 +326,11 @@ class (Eq k) => IsKey k where
-- | Build an 'EnumMapMap' from an 'EnumMapSet' and a function which for each
-- key computes it's value
fromSet :: HasSKey k => (k -> v) -> EnumMapMap (Skey k) () -> EnumMapMap k v
+ -- | The minimal key and value of the 'EnumMapMap'.
+ --
+ -- > findMin empty -- ERROR, no minimal key
+ -- > findMin $ fromList [(K 1, "a", K 3, "b")] == (K 1, a)
+ findMin :: EnumMapMap k v -> (k, v)
-- | 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
@@ -480,6 +485,19 @@ instance (Eq k, Enum k, IsKey t, HasSKey t) => IsKey (k :& t) where
where
go k = fromSet (\nxt -> f $! k :& nxt)
+ findMin (KCC emm) =
+ case emm of
+ Nil -> error "findMin: no minimal element"
+ Tip k v -> (toEnum k :& t, v')
+ where (t, v') = findMin v
+ Bin _ m l r
+ | m < 0 -> go r
+ | otherwise -> go l
+ where go (Tip k v) = (toEnum k :& t, v')
+ where (t, v') = findMin v
+ go (Bin _ _ l' _) = go l'
+ go Nil = error "findMin: 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
12 Data/EnumMapMap/Lazy.hs
@@ -82,6 +82,8 @@ module Data.EnumMapMap.Lazy (
elems,
keysSet,
fromSet,
+ -- * Min/Max
+ findMin,
-- * Split/Join Keys
toK,
toS,
@@ -183,6 +185,16 @@ instance (Enum k, Eq k) => IsKey (K k) where
computeBm !acc Nil = acc
fromSet f (EMS.KSC emm) = KEC $ fromSet_ (f . K . toEnum) emm
+ findMin (KEC emm) =
+ case emm of
+ Nil -> error "findMin: no minimal element"
+ Tip k v -> (K $ toEnum k, v)
+ Bin _ m l r
+ | m < 0 -> go r
+ | otherwise -> go l
+ where go (Tip k v) = (K $ toEnum k, v)
+ go (Bin _ _ l' _) = go l'
+ go Nil = error "findMin: 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
15 Data/EnumMapMap/Strict.hs
@@ -69,8 +69,7 @@ module Data.EnumMapMap.Strict (
intersectionWith,
intersectionWithKey,
intersectSet,
- -- * Traversal
- -- ** Map
+ -- * Map
map,
mapWithKey,
-- * Folds
@@ -83,6 +82,8 @@ module Data.EnumMapMap.Strict (
elems,
keysSet,
fromSet,
+ -- * Min/Max
+ findMin,
-- * Split/Join Keys
toK,
toS,
@@ -182,6 +183,16 @@ instance (Enum k, Eq k) => IsKey (K k) where
computeBm !acc (Tip kx _) = acc .|. EMS.bitmapOf kx
computeBm !acc Nil = acc
fromSet f (EMS.KSC emm) = KEC $ fromSet_ (f . K . toEnum) emm
+ findMin (KEC emm) =
+ case emm of
+ Nil -> error "findMin: no minimal element"
+ Tip k v -> (K $ toEnum k, v)
+ Bin _ m l r
+ | m < 0 -> go r
+ | otherwise -> go l
+ where go (Tip k v) = (K $ toEnum k, v)
+ go (Bin _ _ l' _) = go l'
+ go Nil = error "findMin: 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
@@ -48,7 +48,9 @@ module Data.EnumMapSet (
-- * Lists
toList,
fromList,
- keys
+ keys,
+ -- * Min/Max
+ findMin
) where
import Data.EnumMapSet.Base as EMS
View
24 Data/EnumMapSet/Base.hs
@@ -43,6 +43,8 @@ module Data.EnumMapSet.Base (
toList,
fromList,
keys,
+ -- * Min/Max
+ findMin,
-- * Internals
EMS(..),
EnumMapMap(KSC),
@@ -137,6 +139,18 @@ instance (Enum k, Eq k) => IsKey (S k) where
go init' (Bin _ _ l r) = go (go init' r) l
f' !k t = f (S $ toEnum k) undefined t
+ findMin (KSC ems) =
+ case ems of
+ Nil -> error "findMin: no minimal element"
+ Tip k bm -> (S $ toEnum $ k + lowestBitSet bm, undefined)
+ Bin _ m l r
+ | m < 0 -> go r
+ | otherwise -> go l
+ where go (Tip k bm) = (S $ toEnum $ k + lowestBitSet bm, undefined)
+ go (Bin _ _ l' _) = go l'
+ go Nil = error "findMin: Nil"
+
+
union (KSC ems1) (KSC ems2) = KSC $ go ems1 ems2
where
go t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
@@ -324,6 +338,9 @@ map :: (IsKey k1, IsKey k2, EMM.SubKey k2 k2 (), EMM.Result k2 k2 () ~ ()) =>
(k1 -> k2) -> EnumMapSet k1 -> EnumMapSet k2
map f = fromList . List.map f . toList
+findMin :: (IsKey k) => EnumMapSet k -> k
+findMin = fst . EMM.findMin
+
union :: (IsKey k) => EnumMapSet k -> EnumMapSet k -> EnumMapSet k
union = EMM.union
@@ -436,6 +453,9 @@ instance (Enum k) => EMM.SubKey (S k) (S k) () where
insertWith = undefined
insertWithKey = undefined
+instance (Show v) => Show (EnumMapMap (S k) v) where
+ show (KSC ems) = show ems
+
{---------------------------------------------------------------------
Helper functions
---------------------------------------------------------------------}
@@ -574,3 +594,7 @@ foldrBits prefix f z bitmap = go (revNat bitmap) z
| otherwise = case lowestBitMask bm of
bitmask -> bitmask `seq` case indexOfTheOnlyBit bitmask of
bi -> bi `seq` go (bm `xor` bitmask) ((f $! (prefix+(WORD_SIZE_IN_BITS-1)-bi)) acc)
+
+lowestBitSet :: Nat -> Int
+lowestBitSet x = indexOfTheOnlyBit (lowestBitMask x)
+{-# INLINE lowestBitSet #-}
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 - mapMaybe, update, mergeWithKey, foldr'
+- More functions - minView, mapMaybe, update, mergeWithKey, foldr'
- More benchmarks and optimisation
- More documentation
- More tests
View
2 enummapmap.cabal
@@ -1,5 +1,5 @@
name: enummapmap
-version: 0.4.0
+version: 0.5.0
synopsis: Map of maps using Enum types as keys
description: This package provides 'maps of maps' using Enum types as
keys. The code is based upon Data.IntMap in
View
23 test/EnumMapMapVsIntMap.hs
@@ -8,11 +8,13 @@
import Test.Hspec.Monadic
import Test.Hspec.QuickCheck (prop)
-import Test.QuickCheck ()
+import Test.QuickCheck ((==>))
import qualified Data.IntSet as IS
import Data.EnumMapSet (S(..))
import qualified Data.EnumMapSet as EMS
+import qualified Data.List as L
+
#ifdef LAZY
import qualified Data.IntMap as IM
@@ -393,6 +395,25 @@ main = hspec $ do
runPropL4 (IM.mapWithKey f) (EMM.mapWithKey
(\(k :& _ :& _ :& K _) -> f k))
+ 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
+ prop "Level 2" $ \k1 list ->
+ (not $ L.null list) ==>
+ runProp2 (IM.findMin)
+ (go (\(k :& K _) -> k) . EMM.findMin) k1 list
+ prop "Level 3" $ \k1 k2 list ->
+ (not $ L.null list) ==>
+ runProp3 (IM.findMin)
+ (go (\(k :& _ :& K _) -> k) . EMM.findMin) 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
+
describe "union" $ do
prop "Level 1" $
runPropDuoL IM.union EMM.union
View
17 test/EnumMapSetVsIntSet.hs
@@ -6,9 +6,10 @@
import Test.Hspec.Monadic
import Test.Hspec.QuickCheck (prop)
-import Test.QuickCheck ()
+import Test.QuickCheck ((==>))
import qualified Data.IntSet as IS
+import qualified Data.List as L
import Data.EnumMapSet(EnumMapSet, (:&)(..), S(..))
import qualified Data.EnumMapSet as EMS
@@ -176,6 +177,20 @@ main = hspec $ do
runPropL3 (IS.map f)
(EMS.map (\(k :& k2 :& S k1) -> f k :& k2 :& S k1))
+ describe "findMin" $ do
+ prop "Level 1" $ \list ->
+ (not $ L.null list) ==>
+ runProp (IS.findMin)
+ ((\(S k) -> k) . EMS.findMin) list
+ prop "Level 2" $ \k1 list ->
+ (not $ L.null list) ==>
+ runProp2 (IS.findMin)
+ ((\(k :& S _) -> k) . 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
+
describe "union" $ do
prop "Level 1" $
runPropDuoL1 IS.union EMS.union

No commit comments for this range

Something went wrong with that request. Please try again.