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 @@ -196,9 +196,10 @@ ) where import Prelude hiding (null, lookup, map, filter, foldr, foldl, splitAt) +import Data.Maybe (fromJust) import Data.Bits (shiftR, (.&.)) import Data.Monoid (Monoid(..)) -import Control.Applicative (Applicative(..), (<$>)) +import Control.Applicative (Applicative(..), (<$>), (<|>)) import Data.Traversable (Traversable(traverse)) import qualified Data.Foldable as Foldable import qualified Data.List as L @@ -516,13 +517,13 @@ -- /O(log n)/ average case. findLast :: (Interval k e) => IntervalMap k v -> (k, v) findLast Nil = error "IntervalMap.findLast: empty map" -findLast t@(Node _ _ mx _ _ _) = head (go t) +findLast t@(Node _ _ mx _ _ _) = fromJust (go t) where - go Nil = [] - go (Node _ k m v l r) | sameU m mx = if sameU k m then go r ++ [(k,v)] - else go r ++ go l - | otherwise = [] - sameU a b = upperBound a == upperBound b && rightClosed a == rightClosed b + go Nil = Nothing + go (Node _ k m v l r) | sameU m mx = if sameU k m then go r <|> Just (k,v) + else go r <|> go l + | otherwise = Nothing + sameU a b = compareUpperBounds a b == EQ -- Type to indicate whether the number of black nodes changed or stayed the same. diff --git a/Data/IntervalSet.hs b/Data/IntervalSet.hs --- a/Data/IntervalSet.hs +++ b/Data/IntervalSet.hs @@ -135,6 +135,7 @@ import qualified Data.Foldable as Foldable import qualified Data.List as L import Control.DeepSeq +import Control.Applicative ((<|>)) import qualified Data.Foldable as Foldable import Data.IntervalMap.Generic.Interval @@ -365,13 +366,11 @@ findLast Nil = Nothing findLast t@(Node _ _ mx _ _) = go t where - go (Node _ k m l r) | sameU m mx = if sameU k m then go r `orElse` Just k - else go r `orElse` go l + go (Node _ k m l r) | sameU m mx = if sameU k m then go r <|> Just k + else go r <|> go l | otherwise = Nothing go Nil = Nothing - sameU a b = upperBound a == upperBound b && rightClosed a == rightClosed b - Nothing `orElse` x = x - x `orElse` _ = x + sameU a b = compareUpperBounds a b == EQ -- Type to indicate whether the number of black nodes changed or stayed the same. diff --git a/IntervalMap.cabal b/IntervalMap.cabal --- a/IntervalMap.cabal +++ b/IntervalMap.cabal @@ -1,5 +1,5 @@ Name: IntervalMap -Version: 0.5.1.0 +Version: 0.5.1.1 Stability: experimental Synopsis: Containers for intervals, with efficient search. Homepage: http://www.chr-breitkopf.de/comp/IntervalMap diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2011-2015, Christoph Breitkopf +Copyright (c) 2011-2016, Christoph Breitkopf All rights reserved. diff --git a/bench/BenchAll.hs b/bench/BenchAll.hs --- a/bench/BenchAll.hs +++ b/bench/BenchAll.hs @@ -130,6 +130,13 @@ bench "Data.Map" $ nf (\m -> D.difference m dMapSmall) dMap, bench "IntervalMap" $ nf (\m -> M.difference m dIvMapSmall) dIvMap ], + bgroup "min/max" [ + bench "findMin Data.Map" $ nf D.findMin dMap, + bench "findMax Data.Map" $ nf D.findMax dMap, + bench "findMin IntervalMap" $ nf M.findMin dIvMap, + bench "findMax IntervalMap" $ nf M.findMax dIvMap, + bench "findLast IntervalMap" $ nf M.findLast dIvMap + ], bgroup "delete" [ bench "deleteMin Data.Map" $ nf (bogoSize D.null D.deleteMin) dMap, bench "deleteMax Data.Map" $ nf (bogoSize D.null D.deleteMax) dMap, diff --git a/bench/WeighAllocs.hs b/bench/WeighAllocs.hs --- a/bench/WeighAllocs.hs +++ b/bench/WeighAllocs.hs @@ -11,6 +11,8 @@ import Data.IntervalMap.Generic.Interval import qualified Data.IntervalSet as S import qualified Data.Set as C +import qualified Data.Map.Strict as M +import qualified Data.IntervalMap.Generic.Strict as IVM seed :: Int @@ -56,15 +58,27 @@ cS <- ensure $ C.fromList ivsP sS <- ensure $ S.fromList ivsP oIvsP <- ensure $ C.toAscList cS - daIvsP <- ensure $ [IV x x | x <- [1 .. cDATA_SIZE]] + let m = show (length oIvsP) + kvs <- ensure $ [(iv, lowerBound iv) | iv <- ivsP] + cMap <- ensure $ M.fromList kvs + ivMap <- ensure $ IVM.fromList kvs + oKvs <- ensure $ M.toAscList cMap mainWith (do func ("Data.Set fromList " ++ n) C.fromList ivsP func ("IntervalSet fromList " ++ n) S.fromList ivsP - func ("Data.Set fromAscList " ++ n) C.fromAscList oIvsP - func ("IntervalSet fromAscList " ++ n) S.fromAscList oIvsP - func ("Data.Set fromDistinctAscList " ++ n) C.fromDistinctAscList daIvsP - func ("IntervalSet fromDistinctAscList " ++ n) S.fromDistinctAscList daIvsP - func ("Data.Set mapMonotonic " ++ n) (C.mapMonotonic id) cS - func ("IntervalSet mapMonotonic " ++ n) (S.mapMonotonic id) sS + func ("Data.Set fromAscList " ++ m) C.fromAscList oIvsP + func ("IntervalSet fromAscList " ++ m) S.fromAscList oIvsP + func ("Data.Set fromDistinctAscList " ++ m) C.fromDistinctAscList oIvsP + func ("IntervalSet fromDistinctAscList " ++ m) S.fromDistinctAscList oIvsP + func ("Data.Set mapMonotonic " ++ m) (C.mapMonotonic id) cS + func ("IntervalSet mapMonotonic " ++ m) (S.mapMonotonic id) sS + func ("Data.Map fromList " ++ n) M.fromList kvs + func ("IntervalMap fromList " ++ n) IVM.fromList kvs + func ("Data.Map fromAscList " ++ m) M.fromAscList oKvs + func ("IntervalMap fromAscList " ++ m) IVM.fromAscList oKvs + func ("Data.Map fromDistinctAscList " ++ m) M.fromDistinctAscList oKvs + func ("IntervalMap fromDistinctAscList " ++ m) IVM.fromDistinctAscList oKvs + func ("Data.Map mapKeysMonotonic " ++ m) (M.mapKeysMonotonic id) cMap + func ("IntervalMap mapKeysMonotonic " ++ m) (IVM.mapKeysMonotonic id) ivMap ) diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +0.5.1.1 Improve performance of findLast. + 0.5.1.0 Major performance improvements. 0.5.0.1 Improve performance of combine.