diff --git a/Data/IntervalMap/Generic/Base.hs b/Data/IntervalMap/Generic/Base.hs --- a/Data/IntervalMap/Generic/Base.hs +++ b/Data/IntervalMap/Generic/Base.hs @@ -60,6 +60,10 @@ , notMember , lookup , findWithDefault + , lookupLT + , lookupGT + , lookupLE + , lookupGE -- ** Interval query , containing @@ -381,6 +385,62 @@ findWithDefault def k m = case lookup k m of Nothing -> def Just x -> x + +-- | /O(log n)/. Find the largest key smaller than the given one +-- and return it along with its value. +lookupLT :: (Ord k) => k -> IntervalMap k v -> Maybe (k,v) +lookupLT k m = go m + where + go Nil = Nothing + go (Node _ key _ v l r) | k <= key = go l + | otherwise = go1 key v r + go1 rk rv Nil = Just (rk,rv) + go1 rk rv (Node _ key _ v l r) | k <= key = go1 rk rv l + | otherwise = go1 key v r + +-- | /O(log n)/. Find the smallest key larger than the given one +-- and return it along with its value. +lookupGT :: (Ord k) => k -> IntervalMap k v -> Maybe (k,v) +lookupGT k m = go m + where + go Nil = Nothing + go (Node _ key _ v l r) | k >= key = go r + | otherwise = go1 key v l + go1 rk rv Nil = Just (rk,rv) + go1 rk rv (Node _ key _ v l r) | k >= key = go1 rk rv r + | otherwise = go1 key v l + +-- | /O(log n)/. Find the largest key equal to or smaller than the given one +-- and return it along with its value. +lookupLE :: (Ord k) => k -> IntervalMap k v -> Maybe (k,v) +lookupLE k m = go m + where + go Nil = Nothing + go (Node _ key _ v l r) = case compare k key of + LT -> go l + EQ -> Just (key,v) + GT -> go1 key v r + go1 rk rv Nil = Just (rk,rv) + go1 rk rv (Node _ key _ v l r) = case compare k key of + LT -> go1 rk rv l + EQ -> Just (key,v) + GT -> go1 key v r + +-- | /O(log n)/. Find the smallest key larger than the given one +-- and return it along with its value. +lookupGE :: (Ord k) => k -> IntervalMap k v -> Maybe (k,v) +lookupGE k m = go m + where + go Nil = Nothing + go (Node _ key _ v l r) = case compare k key of + LT -> go1 key v l + EQ -> Just (key,v) + GT -> go r + go1 rk rv Nil = Just (rk,rv) + go1 rk rv (Node _ key _ v l r) = case compare k key of + LT -> go1 key v l + EQ -> Just (key,v) + GT -> go1 rk rv r -- | Return the submap of key intervals containing the given point. -- This is the second element of the value of 'splitAt': diff --git a/Data/IntervalMap/Generic/Lazy.hs b/Data/IntervalMap/Generic/Lazy.hs --- a/Data/IntervalMap/Generic/Lazy.hs +++ b/Data/IntervalMap/Generic/Lazy.hs @@ -30,6 +30,10 @@ , notMember , lookup , findWithDefault + , lookupLT + , lookupGT + , lookupLE + , lookupGE -- ** Interval query , containing diff --git a/Data/IntervalMap/Generic/Strict.hs b/Data/IntervalMap/Generic/Strict.hs --- a/Data/IntervalMap/Generic/Strict.hs +++ b/Data/IntervalMap/Generic/Strict.hs @@ -65,6 +65,10 @@ , notMember , lookup , findWithDefault + , lookupLT + , lookupGT + , lookupLE + , lookupGE -- ** Interval query , containing diff --git a/Data/IntervalMap/Lazy.hs b/Data/IntervalMap/Lazy.hs --- a/Data/IntervalMap/Lazy.hs +++ b/Data/IntervalMap/Lazy.hs @@ -30,6 +30,10 @@ , notMember , lookup , findWithDefault + , lookupLT + , lookupGT + , lookupLE + , lookupGE -- ** Interval query , containing diff --git a/Data/IntervalMap/Strict.hs b/Data/IntervalMap/Strict.hs --- a/Data/IntervalMap/Strict.hs +++ b/Data/IntervalMap/Strict.hs @@ -74,6 +74,10 @@ , notMember , lookup , findWithDefault + , lookupLT + , lookupGT + , lookupLE + , lookupGE -- ** Interval query , containing diff --git a/Data/IntervalSet.hs b/Data/IntervalSet.hs --- a/Data/IntervalSet.hs +++ b/Data/IntervalSet.hs @@ -54,6 +54,10 @@ , size , member , notMember + , lookupLT + , lookupGT + , lookupLE + , lookupGE -- ** Interval query , containing @@ -264,6 +268,59 @@ -- | /O(log n)/. Does the set not contain the given value? See also 'member'. notMember :: (Ord k) => k -> IntervalSet k -> Bool notMember key tree = not (member key tree) + + +-- | /O(log n)/. Find the largest key smaller than the given one. +lookupLT :: (Ord k) => k -> IntervalSet k -> Maybe k +lookupLT k m = go m + where + go Nil = Nothing + go (Node _ key _ l r) | k <= key = go l + | otherwise = go1 key r + go1 rk Nil = Just rk + go1 rk (Node _ key _ l r) | k <= key = go1 rk l + | otherwise = go1 key r + +-- | /O(log n)/. Find the smallest key larger than the given one. +lookupGT :: (Ord k) => k -> IntervalSet k -> Maybe k +lookupGT k m = go m + where + go Nil = Nothing + go (Node _ key _ l r) | k >= key = go r + | otherwise = go1 key l + go1 rk Nil = Just rk + go1 rk (Node _ key _ l r) | k >= key = go1 rk r + | otherwise = go1 key l + +-- | /O(log n)/. Find the largest key equal to or smaller than the given one. +lookupLE :: (Ord k) => k -> IntervalSet k -> Maybe k +lookupLE k m = go m + where + go Nil = Nothing + go (Node _ key _ l r) = case compare k key of + LT -> go l + EQ -> Just key + GT -> go1 key r + go1 rk Nil = Just rk + go1 rk (Node _ key _ l r) = case compare k key of + LT -> go1 rk l + EQ -> Just key + GT -> go1 key r + +-- | /O(log n)/. Find the smallest key equal to or larger than the given one. +lookupGE :: (Ord k) => k -> IntervalSet k -> Maybe k +lookupGE k m = go m + where + go Nil = Nothing + go (Node _ key _ l r) = case compare k key of + LT -> go1 key l + EQ -> Just key + GT -> go r + go1 rk Nil = Just rk + go1 rk (Node _ key _ l r) = case compare k key of + LT -> go1 key l + EQ -> Just key + GT -> go1 rk r -- | Return the set of all intervals containing the given point. -- This is the second element of the value of 'splitAt': diff --git a/IntervalMap.cabal b/IntervalMap.cabal --- a/IntervalMap.cabal +++ b/IntervalMap.cabal @@ -1,5 +1,5 @@ Name: IntervalMap -Version: 0.5.2.0 +Version: 0.5.3.1 Stability: experimental Synopsis: Containers for intervals, with efficient search. Homepage: http://www.chr-breitkopf.de/comp/IntervalMap @@ -8,7 +8,7 @@ Author: Christoph Breitkopf Maintainer: Christoph Breitkopf bug-reports: mailto:chbreitkopf@gmail.com -Copyright: 2011-2016 Christoph Breitkopf +Copyright: 2011-2017 Christoph Breitkopf Category: Data Build-type: Simple Cabal-version: >= 1.8 @@ -25,10 +25,6 @@ bench/*.hs examples/*.lhs -Flag HPC - Description: Enable HPC test coverage support - Default: False - Library Exposed-modules: Data.IntervalMap, Data.IntervalMap.Lazy, Data.IntervalMap.Strict, Data.IntervalMap.Interval, @@ -48,10 +44,7 @@ hs-source-dirs: . test build-depends: base >= 4 && < 5, containers, deepseq, QuickCheck, Cabal >= 1.9.2 - if flag(HPC) - ghc-options: -with-rtsopts=-K1K -fhpc - else - ghc-options: -with-rtsopts=-K1K + ghc-options: -with-rtsopts=-K1K Test-Suite TestGenericInterval @@ -60,10 +53,7 @@ hs-source-dirs: . test build-depends: base >= 4 && < 5, containers, deepseq, QuickCheck, Cabal >= 1.9.2 - if flag(HPC) - ghc-options: -with-rtsopts=-K1K -fhpc - else - ghc-options: -with-rtsopts=-K1K + ghc-options: -with-rtsopts=-K1K Test-Suite TestIntervalMap type: exitcode-stdio-1.0 @@ -71,10 +61,7 @@ hs-source-dirs: . test build-depends: base >= 4 && < 5, containers, deepseq, QuickCheck, Cabal >= 1.9.2 - if flag(HPC) - ghc-options: -with-rtsopts=-K1K -fhpc - else - ghc-options: -with-rtsopts=-K1K + ghc-options: -with-rtsopts=-K1K Test-Suite TestIntervalSet type: exitcode-stdio-1.0 @@ -82,10 +69,7 @@ hs-source-dirs: . test build-depends: base >= 4 && < 5, containers, deepseq, QuickCheck, Cabal >= 1.9.2 - if flag(HPC) - ghc-options: -with-rtsopts=-K1K -fhpc - else - ghc-options: -with-rtsopts=-K1K + ghc-options: -with-rtsopts=-K1K benchmark bench-all type: exitcode-stdio-1.0 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,5 @@ # IntervalMap [![Hackage](https://img.shields.io/hackage/v/IntervalMap.svg)](https://hackage.haskell.org/package/IntervalMap) [![Build Status](https://travis-ci.org/bokesan/IntervalMap.svg?branch=master)](https://travis-ci.org/bokesan/IntervalMap) -*@GitHub users:* please base pull requests on the *develop* branch. Thanks. - Containers for intervals. Like `Data.Set` and `Data.Map` with Intervals as keys and functions for efficiently getting the subset of all intervals containing a point, intersecting an interval, and more. diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +0.5.3.1 Remove HPC flag. +0.5.3.0 Add lookupLT... functions. + 0.5.2.0 Bugfix: exported Prelude functions instead of correct ones. 0.5.1.1 Improve performance of findLast. diff --git a/test/IntervalMapTests.hs b/test/IntervalMapTests.hs --- a/test/IntervalMapTests.hs +++ b/test/IntervalMapTests.hs @@ -153,6 +153,34 @@ in notMember k m' && M.size m == M.size m' + 1 && k == maximum (M.keys m) && valid m' +prop_lookupLT (IMI m) (II k) = case M.lookupLT k m of + Nothing -> all (>= k) (M.keys m) + Just (rk,rv) -> case Prelude.filter (< k) (M.keys m) of + [] -> False + ks -> let mk = maximum ks in + rk == mk && m M.! mk == rv + +prop_lookupGT (IMI m) (II k) = case M.lookupGT k m of + Nothing -> all (<= k) (M.keys m) + Just (rk,rv) -> case Prelude.filter (> k) (M.keys m) of + [] -> False + ks -> let mk = minimum ks in + rk == mk && m M.! mk == rv + +prop_lookupLE (IMI m) (II k) = case M.lookupLE k m of + Nothing -> all (> k) (M.keys m) + Just (rk,rv) -> case Prelude.filter (<= k) (M.keys m) of + [] -> False + ks -> let mk = maximum ks in + rk == mk && m M.! mk == rv + +prop_lookupGE (IMI m) (II k) = case M.lookupGE k m of + Nothing -> all (< k) (M.keys m) + Just (rk,rv) -> case Prelude.filter (>= k) (M.keys m) of + [] -> False + ks -> let mk = minimum ks in + rk == mk && m M.! mk == rv + prop_minViewWithKey (IMI m) = case minViewWithKey m of Nothing -> M.null m Just (kv, m') -> kv == findMin m && valid m' && m' == deleteMin m @@ -475,6 +503,10 @@ check prop_insert "insert" check prop_min "min" check prop_max "max" + check prop_lookupLT "lookupLT" + check prop_lookupGT "lookupGT" + check prop_lookupLE "lookupLE" + check prop_lookupGE "lookupGE" check prop_findWithDefault "findWithDefault" check prop_searchPoint "searchPoint" check prop_searchInterval "searchInterval" diff --git a/test/IntervalSetTests.hs b/test/IntervalSetTests.hs --- a/test/IntervalSetTests.hs +++ b/test/IntervalSetTests.hs @@ -112,7 +112,31 @@ Nothing -> null s Just x@(II _ end) -> all (\e -> upperBound e < end || (upperBound e == end && e <= x)) (toList s) - + +prop_lookupLT (IS s) iv = case lookupLT iv s of + Nothing -> all (>= iv) (toList s) + Just k -> case findMax (filter (< iv) s) of + Nothing -> False + Just m -> k == m + +prop_lookupGT (IS s) iv = case lookupGT iv s of + Nothing -> all (<= iv) (toList s) + Just k -> case findMin (filter (> iv) s) of + Nothing -> False + Just m -> k == m + +prop_lookupLE (IS s) iv = case lookupLE iv s of + Nothing -> all (> iv) (toList s) + Just k -> case findMax (filter (<= iv) s) of + Nothing -> False + Just m -> k == m + +prop_lookupGE (IS s) iv = case lookupGE iv s of + Nothing -> all (< iv) (toList s) + Just k -> case findMin (filter (>= iv) s) of + Nothing -> False + Just m -> k == m + prop_deleteMin (IS s) = let s' = deleteMin s in valid s' && case findMin s of @@ -234,6 +258,10 @@ check prop_findMin "findMin" check prop_findMax "findMax" check prop_findLast "findLast" + check prop_lookupLT "lookupLT" + check prop_lookupGT "lookupGT" + check prop_lookupLE "lookupLE" + check prop_lookupGE "lookupGE" check prop_deleteMin "deleteMin" check prop_deleteMax "deleteMax" check prop_minView "minView"