-- |-- Module : Data.IntervalMap-- Copyright : (c) Christoph Breitkopf 2011-- License : BSD-style-- Maintainer : chbreitkopf@googlemail.com-- Stability : experimental-- Portability : portable---- An implementation of maps from intervals to values. The key intervals may-- overlap, and the implementation supports an efficient stabbing query.---- Since many function names (but not the type name) clash with-- "Prelude" names, this module is usually imported @qualified@, e.g.---- > import Data.IntervalMap (IvMap)-- > import qualified Data.IntervalMap as IvMap---- It offers most of the functions in Data.Map, but 'Interval' /k/ instead of-- just /k/ as the key type. Some of the functions need stricter type constraints to-- maintain the additional information for efficient interval searching,-- for example 'fromDistinctAscList' needs an 'Ord' /k/ constraint.---- Index-based access and some set functions have not been implemented, and many non-core-- functions, for example the set operations, have not been tuned for efficiency yet.---- In addition, there are functions specific to maps of intervals, for example to search-- for all keys containing a given point or contained in a given interval.---- To stay compatible with standard Haskell, this implementation uses a fixed data-- type for intervals, and not a multi-parameter type class. Thus, it's currently-- not possible to define e.g. a 2-tuple as an instance of interval and use that-- map key. Instead you must convert your keys to 'Data.IntervalMap.Interval'.---- Closed, open, and half-open intervals can be contained in the same map.---- It is an error to insert an empty interval into a map. This precondition is not-- checked by the various insertion functions.---- The implementation is a red-black tree augmented with the maximum upper bound-- of all keys.---- Parts of this implementation are based on code from the 'Data.Map' implementation,-- (c) Daan Leijen 2002, (c) Andriy Palamarchuk 2008.-- The red-black tree deletion is based on code from llrbtree by Kazu Yamamoto.-- Of course, any errors are mine.--moduleData.IntervalMap(-- * re-exportInterval(..)-- * Map type,IntervalMap-- instance Eq,Show,Read-- * Operators,(!),(\\)-- * Query,null,size,member,notMember,lookup,findWithDefault-- ** Interval query,containing,intersecting,within-- * Construction,empty,singleton-- ** Insertion,insert,insertWith,insertWith',insertWithKey,insertWithKey',insertLookupWithKey,insertLookupWithKey'-- ** Delete\/Update,delete,adjust,adjustWithKey,update,updateWithKey,updateLookupWithKey,alter-- * Combine-- ** Union,union,unionWith,unionWithKey,unions,unionsWith-- ** Difference,difference,differenceWith,differenceWithKey-- ** Intersection,intersection,intersectionWith,intersectionWithKey-- * Traversal-- ** Map,map,mapWithKey,mapAccum,mapAccumWithKey,mapAccumRWithKey,mapKeys,mapKeysWith,mapKeysMonotonic-- ** Fold,foldr,foldl,foldrWithKey,foldlWithKey,foldl',foldr',foldrWithKey',foldlWithKey'-- * Conversion,elems,keys,keysSet,assocs-- ** Lists,toList,fromList,fromListWith,fromListWithKey-- ** Ordered lists,toAscList,toDescList,fromAscList,fromAscListWith,fromAscListWithKey,fromDistinctAscList-- * Filter ,filter,filterWithKey,partition,partitionWithKey,mapMaybe,mapMaybeWithKey,mapEither,mapEitherWithKey,split,splitLookup{-
-- * Submap
, isSubmapOf, isSubmapOfBy
, isProperSubmapOf, isProperSubmapOfBy
-- * Indexed
, lookupIndex
, findIndex
, elemAt
, updateAt
, deleteAt
-}-- * Min\/Max,findMin,findMax,findLast,deleteMin,deleteMax,deleteFindMin,deleteFindMax,updateMin,updateMax,updateMinWithKey,updateMaxWithKey{-
, minView
, maxView
, minViewWithKey
, maxViewWithKey
-}-- * Debugging,valid-- * Testing,height,maxHeight,showStats)whereimportPreludehiding(null,lookup,map,filter,foldr,foldl)importData.Bits(shiftR,(.&.))importData.Monoid(Monoid(..))importControl.Applicative(Applicative(..),(<$>))importData.Traversable(Traversable(traverse))importqualifiedData.FoldableasFoldableimportqualifiedData.ListasLimportqualifiedData.SetasSetimportControl.DeepSeq(NFData(rnf))importData.IntervalMap.Interval{--------------------------------------------------------------------
Operators
--------------------------------------------------------------------}infixl9!,\\---- | /O(log n)/. Lookup value for given key. Calls 'error' if the key is not in the map.(!)::(Ordk)=>IntervalMapkv->Intervalk->vtree!key=caselookupkeytreeofJustv->vNothing->error"IntervalMap.!: key not found"-- | Same as 'difference'.(\\)::Ordk=>IntervalMapka->IntervalMapkb->IntervalMapkam1\\m2=differencem1m2dataColor=R|Bderiving(Eq,Read,Show)-- | A map from intervals with endpoints of type @k@ to values of type @v@.dataIntervalMapkv=Nil|Node!Color!(Intervalk)-- key!(Intervalk)-- interval with maximum upper in treev-- value!(IntervalMapkv)-- left subtree!(IntervalMapkv)-- right subtreeinstance(Eqk,Eqv)=>Eq(IntervalMapkv)wherea==b=toAscLista==toAscListbinstance(Ordk,Ordv)=>Ord(IntervalMapkv)wherecompareab=compare(toAscLista)(toAscListb)instanceFunctor(IntervalMapk)wherefmapfm=mapfminstance(Ordk)=>Monoid(IntervalMapkv)wheremempty=emptymappend=unionmconcat=unionsinstanceTraversable(IntervalMapk)wheretraverse_Nil=pureNiltraversef(Nodeckmvlr)=flip(Nodeckm)<$>traversefl<*>fv<*>traversefrinstanceFoldable.Foldable(IntervalMapk)wherefoldNil=memptyfold(Node___vlr)=Foldable.foldl`mappend`v`mappend`Foldable.foldrfoldr=foldrfoldl=foldlfoldMap_Nil=memptyfoldMapf(Node___vlr)=Foldable.foldMapfl`mappend`fv`mappend`Foldable.foldMapfrinstance(NFDatak,NFDataa)=>NFData(IntervalMapka)wherernfNil=()rnf(Node_kx_xlr)=rnfkx`seq`rnfx`seq`rnfl`seq`rnfrinstance(Ordk,Readk,Reade)=>Read(IntervalMapke)wherereadsPrecp=readParen(p>10)$\r->do("fromList",s)<-lexr(xs,t)<-readssreturn(fromListxs,t)instance(Showk,Showa)=>Show(IntervalMapka)whereshowsPrecdm=showParen(d>10)$showString"fromList ".shows(toListm)isRed::IntervalMapkv->BoolisRed(NodeR_____)=TrueisRed_=FalseturnBlack::IntervalMapkv->IntervalMapkvturnBlack(NodeRkmvslr)=NodeBkmvslrturnBlackt=tturnRed::IntervalMapkv->IntervalMapkvturnRedNil=error"turnRed: Leaf"turnRed(NodeBkmvlr)=NodeRkmvlrturnRedt=t-- construct node, recomputing the upper key bound.mNode::(Ordk)=>Color->Intervalk->v->IntervalMapkv->IntervalMapkv->IntervalMapkvmNodeckvlr=Nodeck(maxUpperklr)vlrmaxUpper::Ordk=>Intervalk->IntervalMapkv->IntervalMapkv->IntervalkmaxUpperkNilNil=k`seq`kmaxUpperkNil(Node__m___)=maxByUpperkmmaxUpperk(Node__m___)Nil=maxByUpperkmmaxUpperk(Node__l___)(Node__r___)=maxByUpperk(maxByUpperlr)-- interval with the greatest upper bound. The lower bound is ignored!maxByUpper::Orda=>Intervala->Intervala->IntervalamaxByUppera@(IntervalCO_u)b=ifu>upperBoundbthenaelsebmaxByUppera@(ClosedInterval_u)b=ifu>=upperBoundbthenaelsebmaxByUppera@(OpenInterval_u)b=ifu>upperBoundbthenaelsebmaxByUppera@(IntervalOC_u)b=ifu>=upperBoundbthenaelseb-- ----------------------------------------------------------- | /O(1)/. The empty map.empty::IntervalMapkvempty=Nil-- | /O(1)/. A map with one entry.singleton::Intervalk->v->IntervalMapkvsingletonkv=NodeBkkvNilNil-- | /O(1)/. Is the map empty?null::IntervalMapkv->BoolnullNil=Truenull_=False-- | /O(n)/. Number of keys in the map.size::IntervalMapkv->Intsizet=h0twherehnm=n`seq`casemofNil->nNode____lr->h(hnl+1)r-- | The height of the tree. For testing/debugging only.height::IntervalMapkv->IntheightNil=0height(Node____lr)=1+max(heightl)(heightr)-- | The maximum height of a red-black tree with the given number of nodes.maxHeight::Int->IntmaxHeightnodes=2*log2(nodes+1)-- | Tree statistics (size, height, maxHeight size)showStats::IntervalMapka->(Int,Int,Int)showStatsm=(n,heightm,maxHeightn)wheren=sizem-- | /O(log n)/. Does the map contain the given key? See also 'notMember'.member::(Ordk)=>Intervalk->IntervalMapkv->Boolmemberkeytree=caselookupkeytreeofNothing->FalseJust_->True-- | /O(log n)/. Does the map not contain the given key? See also 'member'.notMember::(Ordk)=>Intervalk->IntervalMapkv->BoolnotMemberkeytree=not(memberkeytree)-- | /O(log n)/. Look up the given key in the map, returning the value @('Just' value)@,-- or 'Nothing' if the key is not in the map.lookup::(Ordk)=>Intervalk->IntervalMapkv->MaybevlookupkNil=k`seq`Nothinglookupk(Node_key_vlr)=casecomparekkeyofLT->lookupklGT->lookupkrEQ->Justv-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns-- the value at key @k@ or returns default value @def@-- when the key is not in the map.---- > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x'-- > findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) == 'a'findWithDefault::Ordk=>a->Intervalk->IntervalMapka->afindWithDefaultdefkm=caselookupkmofNothing->defJustx->x-- | Return all key/value pairs where the key intervals contain the given point.-- The elements are returned in ascending key order.---- /O(n)/, since potentially all keys could contain the point.-- /O(log n)/ average case. This is also the worst case for maps containing no overlapping keys.containing::(Ordk)=>IntervalMapkv->k->[(Intervalk,v)]t`containing`pt=go[]pttwheregoxspNil=p`seq`xsgoxsp(Node_kmvlr)|p`above`m=xs-- above all intervals in the tree: no result|p`below`k=goxspl-- to the left of the lower bound: can't be in right subtree|p`inside`k=go((k,v):goxspr)pl|otherwise=go(goxspr)pl-- | Return all key/value pairs where the key intervals overlap (intersect) the given interval.-- The elements are returned in ascending key order.---- /O(n)/, since potentially all keys could intersect the interval.-- /O(log n)/ average case, if few keys intersect the interval.intersecting::(Ordk)=>IntervalMapkv->Intervalk->[(Intervalk,v)]t`intersecting`iv=go[]ivtwheregoxsiNil=i`seq`xsgoxsi(Node_kmvlr)|i`after`m=xs|i`before`k=goxsil|i`overlaps`k=go((k,v):goxsir)il|otherwise=go(goxsir)il-- | Return all key/value pairs where the key intervals are completely inside the given interval.-- The elements are returned in ascending key order.---- /O(n)/, since potentially all keys could be inside the interval.-- /O(log n)/ average case, if few keys are inside the interval.within::(Ordk)=>IntervalMapkv->Intervalk->[(Intervalk,v)]t`within`iv=go[]ivtwheregoxsiNil=i`seq`xsgoxsi(Node_kmvlr)|i`after`m=xs|i`before`k=goxsil|i`subsumes`k=go((k,v):goxsir)il|otherwise=go(goxsir)il-- | /O(log n)/. Insert a new key/value pair. If the map already contains the key, its value is-- changed to the new value.insert::(Ordk)=>Intervalk->v->IntervalMapkv->IntervalMapkvinsert=insertWithKey'(\_v_->v){-# INLINE insert #-}-- | /O(log n)/. Insert with a function, combining new value and old value.-- @'insertWith' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does-- not exist in the map. If the key does exist, the function will-- insert the pair @(key, f new_value old_value)@.insertWith::(Ordk)=>(v->v->v)->Intervalk->v->IntervalMapkv->IntervalMapkvinsertWithf=insertWithKey(\_newold->fnewold){-# INLINE insertWith #-}-- | Same as 'insertWith', but the combining function is applied strictly.-- This is often the most desirable behavior.insertWith'::(Ordk)=>(v->v->v)->Intervalk->v->IntervalMapkv->IntervalMapkvinsertWith'f=insertWithKey'(\_newold->fnewold){-# INLINE insertWith' #-}-- | /O(log n)/. Insert with a function, combining key, new value and old value.-- @'insertWithKey' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does-- not exist in the map. If the key does exist, the function will-- insert the pair @(key,f key new_value old_value)@.-- Note that the key passed to f is the same key passed to 'insertWithKey'.insertWithKey::(Ordk)=>(Intervalk->v->v->v)->Intervalk->v->IntervalMapkv->IntervalMapkvinsertWithKeyfkvm=snd(insertLookupWithKeyfkvm){-# INLINE insertWithKey #-}-- | Same as 'insertWithKey', but the combining function is applied strictly.insertWithKey'::(Ordk)=>(Intervalk->v->v->v)->Intervalk->v->IntervalMapkv->IntervalMapkvinsertWithKey'fkvm=snd(insertLookupWithKey'fkvm){-# INLINE insertWithKey' #-}-- | /O(log n)/. Combine insert with old values retrieval.insertLookupWithKey::(Ordk)=>(Intervalk->v->v->v)->Intervalk->v->IntervalMapkv->(Maybev,IntervalMapkv)insertLookupWithKeyfkeyvaluemp=key`seq`(oldval,turnBlackmp')where(oldval,mp')=insmpsingletonRkv=NodeRkkvNilNilinsNil=(Nothing,singletonRkeyvalue)ins(Nodecolorkmvlr)=casecomparekeykofLT->caseinslof(x@(Just_),t')->(x,Nodecolorkmvt'r)(Nothing,t')->(Nothing,balanceLcolorkvt'r)GT->caseinsrof(x@(Just_),t')->(x,Nodecolorkmvlt')(Nothing,t')->(Nothing,balanceRcolorkvlt')EQ->(Justv,Nodecolorkm(fkvaluev)lr)-- | /O(log n)/. A strict version of 'insertLookupWithKey'.insertLookupWithKey'::(Ordk)=>(Intervalk->v->v->v)->Intervalk->v->IntervalMapkv->(Maybev,IntervalMapkv)insertLookupWithKey'fkeyvaluemp=key`seq`(oldval,turnBlackmp')where(oldval,mp')=insmpsingletonRkv=NodeRkkvNilNilinsNil=value`seq`(Nothing,singletonRkeyvalue)ins(Nodecolorkmvlr)=casecomparekeykofLT->caseinslof(x@(Just_),t')->(x,Nodecolorkmvt'r)(Nothing,t')->(Nothing,balanceLcolorkvt'r)GT->caseinsrof(x@(Just_),t')->(x,Nodecolorkmvlt')(Nothing,t')->(Nothing,balanceRcolorkvlt')EQ->letv'=fkvaluevinv'`seq`(Justv,Nodecolorkmv'lr)balanceL::Ordk=>Color->Intervalk->v->IntervalMapkv->IntervalMapkv->IntervalMapkvbalanceLBzkzv(NodeRyk_yv(NodeRxk_xvab)c)d=mNodeRykyv(mNodeBxkxvab)(mNodeBzkzvcd)balanceLBzkzv(NodeRxk_xva(NodeRyk_yvbc))d=mNodeRykyv(mNodeBxkxvab)(mNodeBzkzvcd)balanceLcxkxvlr=mNodecxkxvlrbalanceR::Ordk=>Color->Intervalk->v->IntervalMapkv->IntervalMapkv->IntervalMapkvbalanceRBxkxva(NodeRyk_yvb(NodeRzk_zvcd))=mNodeRykyv(mNodeBxkxvab)(mNodeBzkzvcd)balanceRBxkxva(NodeRzk_zv(NodeRyk_yvbc)d)=mNodeRykyv(mNodeBxkxvab)(mNodeBzkzvcd)balanceRcxkxvlr=mNodecxkxvlr-- min/max-- | /O(log n)/. Returns the smallest key and its associated value.-- Calls 'error' if the map is empty.findMin::IntervalMapkv->(Intervalk,v)findMin(Node_k_vNil_)=(k,v)findMin(Node____l_)=findMinlfindMinNil=error"IntervalMap.findMin: empty map"-- | /O(log n)/. Returns the largest key and its associated value.-- Calls 'error' if the map is empty.findMax::IntervalMapkv->(Intervalk,v)findMax(Node_k_v_Nil)=(k,v)findMax(Node_____r)=findMaxrfindMaxNil=error"IntervalMap.findMin: empty map"-- | Returns the interval with the largest endpoint.-- If there is more than one interval with that endpoint,-- return the rightmost.---- /O(n)/, since all keys could have the same endpoint.-- /O(log n)/ average case.findLast::Eqk=>IntervalMapkv->(Intervalk,v)findLastNil=error"IntervalMap.findLast: empty map"findLastt@(Node__mx___)=lastMaxwhere(lastMax:_)=gotgoNil=[]go(Node_kmvlr)|sameUmmx=ifsameUkmthengor++((k,v):gol)elsegor++gol|otherwise=[]sameUab=upperBounda==upperBoundb&&rightCloseda==rightClosedb-- use our own Either type for readabilitydataDeleteResultkv=Unchanged!(IntervalMapkv)|Shrunk!(IntervalMapkv)-- | /O(log n)/. Remove the smallest key from the map. Return the empty map if the map is empty.deleteMin::(Ordk)=>IntervalMapkv->IntervalMapkvdeleteMinNil=NildeleteMinmp=casedeleteMin'mpof(Unchangedr,_,_)->turnBlackr(Shrunkr,_,_)->turnBlackrdeleteMin'::Ordk=>IntervalMapkv->(DeleteResultkv,Intervalk,v)deleteMin'Nil=error"deleteMin': Nil"deleteMin'(NodeBk_vNilNil)=(ShrunkNil,k,v)deleteMin'(NodeBk_vNilr@(NodeR_____))=(Unchanged(turnBlackr),k,v)deleteMin'(NodeRk_vNilr)=(Unchangedr,k,v)deleteMin'(Nodeck_vlr)=casedeleteMin'lof(Unchangedl',rk,rv)->(Unchanged(mNodeckvl'r),rk,rv)(Shrunkl',rk,rv)->(unbalancedRckvl'r,rk,rv)deleteMax'::Ordk=>IntervalMapkv->(DeleteResultkv,Intervalk,v)deleteMax'Nil=error"deleteMax': Nil"deleteMax'(NodeBk_vNilNil)=(ShrunkNil,k,v)deleteMax'(NodeBk_vl@(NodeR_____)Nil)=(Unchanged(turnBlackl),k,v)deleteMax'(NodeRk_vlNil)=(Unchangedl,k,v)deleteMax'(Nodeck_vlr)=casedeleteMax'rof(Unchangedr',rk,rv)->(Unchanged(mNodeckvlr'),rk,rv)(Shrunkr',rk,rv)->(unbalancedLckvlr',rk,rv)-- The left tree lacks one Black nodeunbalancedR::Ordk=>Color->Intervalk->v->IntervalMapkv->IntervalMapkv->DeleteResultkv-- Decreasing one Black node in the rightunbalancedRBkvlr@(NodeB_____)=Shrunk(balanceRBkvl(turnRedr))unbalancedRRkvlr@(NodeB_____)=Unchanged(balanceRBkvl(turnRedr))-- Taking one Red node from the right and adding it to the right as BlackunbalancedRBkvl(NodeRrk_rvrl@(NodeB_____)rr)=Unchanged(mNodeBrkrv(balanceRBkvl(turnRedrl))rr)unbalancedR_____=error"unbalancedR"unbalancedL::Ordk=>Color->Intervalk->v->IntervalMapkv->IntervalMapkv->DeleteResultkvunbalancedLBkvl@(NodeB_____)r=Shrunk(balanceLBkv(turnRedl)r)unbalancedLRkvl@(NodeB_____)r=Unchanged(balanceLBkv(turnRedl)r)unbalancedLBkv(NodeRlk_lvlllr@(NodeB_____))r=Unchanged(mNodeBlklvll(balanceLBkv(turnRedlr)r))unbalancedL_____=error"unbalancedL"-- | /O(log n)/. Remove the largest key from the map. Return the empty map if the map is empty.deleteMax::(Ordk)=>IntervalMapkv->IntervalMapkvdeleteMaxNil=NildeleteMaxmp=casedeleteMax'mpof(Unchangedr,_,_)->turnBlackr(Shrunkr,_,_)->turnBlackr-- | /O(log n)/. Delete and return the smallest key.deleteFindMin::(Ordk)=>IntervalMapkv->((Intervalk,v),IntervalMapkv)deleteFindMinmp=casedeleteMin'mpof(Unchangedr,k,v)->((k,v),turnBlackr)(Shrunkr,k,v)->((k,v),turnBlackr)-- | /O(log n)/. Delete and return the largest key.deleteFindMax::(Ordk)=>IntervalMapkv->((Intervalk,v),IntervalMapkv)deleteFindMaxmp=casedeleteMax'mpof(Unchangedr,k,v)->((k,v),turnBlackr)(Shrunkr,k,v)->((k,v),turnBlackr)-- | /O(log n)/. Update or delete value at minimum key.updateMin::Ordk=>(v->Maybev)->IntervalMapkv->IntervalMapkvupdateMinfm=updateMinWithKey(\_v->fv)m-- | /O(log n)/. Update or delete value at maximum key.updateMax::Ordk=>(v->Maybev)->IntervalMapkv->IntervalMapkvupdateMaxfm=updateMaxWithKey(\_v->fv)m-- | /O(log n)/. Update or delete value at minimum key.updateMinWithKey::Ordk=>(Intervalk->v->Maybev)->IntervalMapkv->IntervalMapkvupdateMinWithKey_Nil=NilupdateMinWithKeyfm=let(k,v)=findMinmincasefkvofJustv'->setMinValuev'mNothing->deleteMinm-- | /O(log n)/. Update or delete value at maximum key.updateMaxWithKey::Ordk=>(Intervalk->v->Maybev)->IntervalMapkv->IntervalMapkvupdateMaxWithKey_Nil=NilupdateMaxWithKeyfm=let(k,v)=findMaxmincasefkvofJustv'->setMaxValuev'mNothing->deleteMaxmsetMinValue::v->IntervalMapkv->IntervalMapkvsetMinValue_Nil=NilsetMinValuev'(Nodeckm_Nilr)=Nodeckmv'NilrsetMinValuev'(Nodeckmvlr)=Nodeckmv(setMinValuev'l)rsetMaxValue::v->IntervalMapkv->IntervalMapkvsetMaxValue_Nil=NilsetMaxValuev'(Nodeckm_lNil)=Nodeckmv'lNilsetMaxValuev'(Nodeckmvlr)=Nodeckmvl(setMaxValuev'r)-- folding-- | /O(n)/. Fold the values in the map using the given right-associative-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.foldr::(a->b->b)->b->IntervalMapka->bfoldr_zNil=zfoldrfz(Node___xlr)=foldrf(fx(foldrfzr))l-- | /O(n)/. A strict version of 'foldr'. Each application of the operator is-- evaluated before using the result in the next application. This-- function is strict in the starting value.foldr'::(a->b->b)->b->IntervalMapka->bfoldr'fzm=z`seq`casemofNil->zNode___xlr->foldr'f(fx(foldr'fzr))l-- | /O(n)/. Fold the values in the map using the given left-associative-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.foldl::(b->a->b)->b->IntervalMapka->bfoldl_zNil=zfoldlfz(Node___xlr)=foldlf(f(foldlfzl)x)r-- | /O(n)/. A strict version of 'foldl'. Each application of the operator is-- evaluated before using the result in the next application. This-- function is strict in the starting value.foldl'::(b->a->b)->b->IntervalMapka->bfoldl'fzm=z`seq`casemofNil->zNode___xlr->foldl'f(f(foldl'fzl)x)r-- | /O(n)/. Fold the keys and values in the map using the given right-associative-- binary operator, such that-- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.foldrWithKey::(Intervalk->v->a->a)->a->IntervalMapkv->afoldrWithKey_zNil=zfoldrWithKeyfz(Node_k_xlr)=foldrWithKeyf(fkx(foldrWithKeyfzr))l-- | /O(n)/. A strict version of 'foldrWithKey'. Each application of the operator is-- evaluated before using the result in the next application. This-- function is strict in the starting value.foldrWithKey'::(Intervalk->v->a->a)->a->IntervalMapkv->afoldrWithKey'fzm=z`seq`casemofNil->zNode_k_xlr->foldrWithKey'f(fkx(foldrWithKey'fzr))l-- | /O(n)/. Fold the keys and values in the map using the given left-associative-- binary operator, such that-- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@.foldlWithKey::(a->Intervalk->v->a)->a->IntervalMapkv->afoldlWithKey_zNil=zfoldlWithKeyfz(Node_k_xlr)=foldlWithKeyf(f(foldlWithKeyfzl)kx)r-- | /O(n)/. A strict version of 'foldlWithKey'. Each application of the operator is-- evaluated before using the result in the next application. This-- function is strict in the starting value.foldlWithKey'::(a->Intervalk->v->a)->a->IntervalMapkv->afoldlWithKey'fzm=z`seq`casemofNil->zNode_k_xlr->foldlWithKey'f(f(foldlWithKey'fzl)kx)r-- delete-- | /O(log n)/. Delete a key from the map. If the map does not contain the key,-- it is returned unchanged.delete::(Ordk)=>Intervalk->IntervalMapkv->IntervalMapkvdeletekeymp=casedelete'keympofUnchangedr->turnBlackrShrunkr->turnBlackrdelete'::Ordk=>Intervalk->IntervalMapkv->DeleteResultkvdelete'xNil=x`seq`UnchangedNildelete'x(Nodeck_vlr)=casecomparexkofLT->casedelete'xlof(Unchangedl')->Unchanged(mNodeckvl'r)(Shrunkl')->unbalancedRckvl'rGT->casedelete'xrof(Unchangedr')->Unchanged(mNodeckvlr')(Shrunkr')->unbalancedLckvlr'EQ->caserofNil->ifc==BthenblackifylelseUnchangedl_->casedeleteMin'rof(Unchangedr',rk,rv)->Unchanged(mNodecrkrvlr')(Shrunkr',rk,rv)->unbalancedLcrkrvlr'blackify::IntervalMapkv->DeleteResultkvblackifys@(NodeR_____)=Unchanged(turnBlacks)blackifys=Shrunks-- | /O(log n)/. Update a value at a specific key with the result of the provided function.-- When the key is not-- a member of the map, the original map is returned.adjust::Ordk=>(a->a)->Intervalk->IntervalMapka->IntervalMapkaadjustfkm=adjustWithKey(\_v->fv)km{-# INLINE adjust #-}-- | /O(log n)/. Adjust a value at a specific key. When the key is not-- a member of the map, the original map is returned.adjustWithKey::Ordk=>(Intervalk->a->a)->Intervalk->IntervalMapka->IntervalMapkaadjustWithKey__Nil=NiladjustWithKeyfx(Nodeckmvlr)=casecomparexkofLT->Nodeckmv(adjustWithKeyfxl)rGT->Nodeckmvl(adjustWithKeyfxr)EQ->Nodeckm(fkv)lr-- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@-- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.update::Ordk=>(a->Maybea)->Intervalk->IntervalMapka->IntervalMapkaupdatefkm=updateWithKey(\_v->fv)km{-# INLINE update #-}-- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the-- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing',-- the element is deleted. If it is (@'Just' y@), the key @k@ is bound-- to the new value @y@.updateWithKey::Ordk=>(Intervalk->a->Maybea)->Intervalk->IntervalMapka->IntervalMapkaupdateWithKeyfkm=snd(updateLookupWithKeyfkm){-# INLINE updateWithKey #-}-- | /O(log n)/. Lookup and update. See also 'updateWithKey'.-- The function returns changed value, if it is updated.-- Returns the original key value if the map entry is deleted.updateLookupWithKey::Ordk=>(Intervalk->a->Maybea)->Intervalk->IntervalMapka->(Maybea,IntervalMapka)updateLookupWithKeyfxm=caselookupxmofNothing->(Nothing,m)r@(Justv)->casefxvofNothing->(r,deletexm)r'@(Justv')->(r',adjust(constv')xm)-- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.-- 'alter' can be used to insert, delete, or update a value in a 'Map'.-- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.alter::Ordk=>(Maybea->Maybea)->Intervalk->IntervalMapka->IntervalMapkaalterfxm=caselookupxmofNothing->casefNothingofNothing->mJustv->insertxvmy->casefyofNothing->deletexmJustv'->adjust(constv')xm-- | /O(n+m)/. The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@. -- It prefers @t1@ when duplicate keys are encountered,-- i.e. (@'union' == 'unionWith' 'const'@).union::Ordk=>IntervalMapka->IntervalMapka->IntervalMapkaunionm1m2=unionWithconstm1m2{-# INLINE union #-}-- | /O(n+m)/. Union with a combining function.unionWith::Ordk=>(a->a->a)->IntervalMapka->IntervalMapka->IntervalMapkaunionWithfm1m2=unionWithKey(\_v1v2->fv1v2)m1m2{-# INLINE unionWith #-}-- | /O(n+m)/. Union with a combining function.unionWithKey::Ordk=>(Intervalk->a->a->a)->IntervalMapka->IntervalMapka->IntervalMapkaunionWithKeyfm1m2=fromDistinctAscList(ascListUnionf(toAscListm1)(toAscListm2))-- | The union of a list of maps:-- (@'unions' == 'Prelude.foldl' 'union' 'empty'@).unions::Ordk=>[IntervalMapka]->IntervalMapkaunions=L.foldlunionempty-- | The union of a list of maps, with a combining operation:-- (@'unionsWith' f == 'Prelude.foldl' ('unionWith' f) 'empty'@).unionsWith::Ordk=>(a->a->a)->[IntervalMapka]->IntervalMapkaunionsWithf=L.foldl(unionWithf)empty-- | /O(n+m)/. Difference of two maps. -- Return elements of the first map not existing in the second map.difference::Ordk=>IntervalMapka->IntervalMapkb->IntervalMapkadifferencem1m2=differenceWithKey(\___->Nothing)m1m2{-# INLINE difference #-}-- | /O(n+m)/. Difference with a combining function. -- When two equal keys are-- encountered, the combining function is applied to the values of these keys.-- If it returns 'Nothing', the element is discarded (proper set difference). If-- it returns (@'Just' y@), the element is updated with a new value @y@. differenceWith::Ordk=>(a->b->Maybea)->IntervalMapka->IntervalMapkb->IntervalMapkadifferenceWithfm1m2=differenceWithKey(\_v1v2->fv1v2)m1m2{-# INLINE differenceWith #-}-- | /O(n+m)/. Difference with a combining function. When two equal keys are-- encountered, the combining function is applied to the key and both values.-- If it returns 'Nothing', the element is discarded (proper set difference). If-- it returns (@'Just' y@), the element is updated with a new value @y@. differenceWithKey::Ordk=>(Intervalk->a->b->Maybea)->IntervalMapka->IntervalMapkb->IntervalMapkadifferenceWithKeyfm1m2=fromDistinctAscList(ascListDifferencef(toAscListm1)(toAscListm2))-- | /O(n+m)/. Intersection of two maps.-- Return data in the first map for the keys existing in both maps.-- (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@).intersection::Ordk=>IntervalMapka->IntervalMapkb->IntervalMapkaintersectionm1m2=intersectionWithKey(\_v_->v)m1m2{-# INLINE intersection #-}-- | /O(n+m)/. Intersection with a combining function.intersectionWith::Ordk=>(a->b->c)->IntervalMapka->IntervalMapkb->IntervalMapkcintersectionWithfm1m2=intersectionWithKey(\_v1v2->fv1v2)m1m2{-# INLINE intersectionWith #-}-- | /O(n+m)/. Intersection with a combining function.intersectionWithKey::Ordk=>(Intervalk->a->b->c)->IntervalMapka->IntervalMapkb->IntervalMapkcintersectionWithKeyfm1m2=fromDistinctAscList(ascListIntersectionf(toAscListm1)(toAscListm2))ascListUnion::Ordk=>(k->a->a->a)->[(k,a)]->[(k,a)]->[(k,a)]ascListUnion_[][]=[]ascListUnion_[]ys=ysascListUnion_xs[]=xsascListUnionfxs@(x@(xk,xv):xs')ys@(y@(yk,yv):ys')=casecomparexkykofLT->x:ascListUnionfxs'ysGT->y:ascListUnionfxsys'EQ->(xk,fxkxvyv):ascListUnionfxs'ys'ascListDifference::Ordk=>(k->a->b->Maybea)->[(k,a)]->[(k,b)]->[(k,a)]ascListDifference_[]_=[]ascListDifference_xs[]=xsascListDifferencefxs@(x@(xk,xv):xs')ys@((yk,yv):ys')=casecomparexkykofLT->x:ascListDifferencefxs'ysGT->ascListDifferencefxsys'EQ->casefxkxvyvofNothing->ascListDifferencefxs'ys'Justv'->(xk,v'):ascListDifferencefxs'ys'ascListIntersection::Ordk=>(k->a->b->c)->[(k,a)]->[(k,b)]->[(k,c)]ascListIntersection_[]_=[]ascListIntersection__[]=[]ascListIntersectionfxs@((xk,xv):xs')ys@((yk,yv):ys')=casecomparexkykofLT->ascListIntersectionfxs'ysGT->ascListIntersectionfxsys'EQ->(xk,fxkxvyv):ascListIntersectionfxs'ys'-- --- Conversion ----- | /O(n)/. The list of all key\/value pairs contained in the map, in ascending order of keys.toAscList::IntervalMapkv->[(Intervalk,v)]toAscListm=foldrWithKey(\kvr->(k,v):r)[]m-- | /O(n)/. The list of all key\/value pairs contained in the map, in no particular order.toList::IntervalMapkv->[(Intervalk,v)]toListm=toAscListm-- | /O(n)/. The list of all key\/value pairs contained in the map, in descending order of keys.toDescList::IntervalMapkv->[(Intervalk,v)]toDescListm=foldlWithKey(\rkv->(k,v):r)[]m-- | /O(n log n)/. Build a map from a list of key\/value pairs. See also 'fromAscList'.-- If the list contains more than one value for the same key, the last value-- for the key is retained.fromList::Ordk=>[(Intervalk,v)]->IntervalMapkvfromListxs=L.foldl'(\m(k,v)->insertkvm)emptyxs-- | /O(n log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.fromListWith::Ordk=>(a->a->a)->[(Intervalk,a)]->IntervalMapkafromListWithfxs=fromListWithKey(\_xy->fxy)xs-- | /O(n log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.fromListWithKey::Ordk=>(Intervalk->a->a->a)->[(Intervalk,a)]->IntervalMapkafromListWithKeyfxs=L.foldl'insemptyxswhereinst(k,x)=insertWithKeyfkxt-- | /O(n)/. Build a map from an ascending list in linear time.-- /The precondition (input list is ascending) is not checked./fromAscList::Ordk=>[(Intervalk,v)]->IntervalMapkvfromAscListxs=fromAscListWith(\_b->b)xs-- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.-- /The precondition (input list is ascending) is not checked./fromAscListWith::Ordk=>(a->a->a)->[(Intervalk,a)]->IntervalMapkafromAscListWithfxs=fromAscListWithKey(\_ab->fab)xs-- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.-- /The precondition (input list is ascending) is not checked./fromAscListWithKey::Ordk=>(Intervalk->a->a->a)->[(Intervalk,a)]->IntervalMapkafromAscListWithKeyfxs=fromDistinctAscList(combineEqfxs)combineEq::Eqk=>(k->a->a->a)->[(k,a)]->[(k,a)]combineEq_[]=[]combineEq_xs@[_]=xscombineEqf(x@(xk,xv):xs@((yk,yv):xs'))|xk==yk=combineEqf((xk,fxkxvyv):xs')|otherwise=x:combineEqfxs-- | /O(n)/. Build a map from an ascending list of elements with distinct keys in linear time.-- /The precondition is not checked./fromDistinctAscList::(Ordk)=>[(Intervalk,v)]->IntervalMapkv-- exactly 2^n-1 items have height n. They can be all black-- from 2^n - 2^n-2 items have height n+1. The lowest "row" should be red.fromDistinctAscListlyst=caseh(lengthlyst)lystof(result,[])->result_->error"fromDistinctAscList: list not fully consumed"wherehnxs|n==0=(Nil,xs)|isPerfectn=buildBnxs|otherwise=buildRn(log2n)xsbuildBnxs|n<=0=error"fromDictinctAscList: buildB 0"|n==1=casexsof((k,v):xs')->(NodeBkkvNilNil,xs')|otherwise=casen`quot`2of{n'->casebuildBn'xsof{(l,(k,v):xs')->casebuildBn'xs'of{(r,xs'')->(mNodeBkvlr,xs'')}}}buildRndxs|d`seq`n==0=(Nil,xs)|n==1=casexsof((k,v):xs')->(Node(ifd==0thenRelseB)kkvNilNil,xs')|otherwise=casen`quot`2of{n'->casebuildRn'(d-1)xsof{(l,(k,v):xs')->casebuildR(n-(n'+1))(d-1)xs'of{(r,xs'')->(mNodeBkvlr,xs'')}}}-- is n a perfect binary tree size (2^m-1)?isPerfect::Int->BoolisPerfectn=(n.&.(n+1))==0{-# INLINE isPerfect #-}log2::Int->Intlog2m=h(-1)mwherehrn|n<=0=r|otherwise=h(r+1)(n`shiftR`1)-- | /O(n)/. List of all values in the map, in ascending order of their keys.elems::IntervalMapkv->[v]elemsm=[v|(_,v)<-toAscListm]-- | /O(n)/. List of all keys in the map, in ascending order.keys::IntervalMapkv->[Intervalk]keysm=[k|(k,_)<-toAscListm]-- | /O(n)/. Set of the keys.keysSet::(Ordk)=>IntervalMapkv->Set.Set(Intervalk)keysSetm=Set.fromDistinctAscList(keysm)-- | Same as 'toAscList'.assocs::IntervalMapkv->[(Intervalk,v)]assocsm=toAscListm{-# INLINE assocs #-}-- --- Mapping ----- | /O(n)/. Map a function over all values in the map.map::(a->b)->IntervalMapka->IntervalMapkbmapf=mapWithKey(\_x->fx){-# INLINE map #-}-- | /O(n)/. Map a function over all values in the map.mapWithKey::(Intervalk->a->b)->IntervalMapka->IntervalMapkbmapWithKeyf=gowheregoNil=Nilgo(Nodeckmvlr)=Nodeckm(fkv)(gol)(gor)-- | /O(n)/. The function 'mapAccum' threads an accumulating-- argument through the map in ascending order of keys.---- > let f a b = (a ++ b, b ++ "X")-- > mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) == ("Everything: ba", fromList [(3, "bX"), (5, "aX")])mapAccum::(a->b->(a,c))->a->IntervalMapkb->(a,IntervalMapkc)mapAccumfam=mapAccumWithKey(\a'_x'->fa'x')am{-# INLINE mapAccum #-}-- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating-- argument through the map in ascending order of keys.---- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")-- > mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) == ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])mapAccumWithKey::(a->Intervalk->b->(a,c))->a->IntervalMapkb->(a,IntervalMapkc)mapAccumWithKeyfat=mapAccumLfat{-# INLINE mapAccumWithKey #-}-- | /O(n)/. The function 'mapAccumL' threads an accumulating-- argument throught the map in ascending order of keys.mapAccumL::(a->Intervalk->b->(a,c))->a->IntervalMapkb->(a,IntervalMapkc)mapAccumLf=gowheregoaNil=(a,Nil)goa(Nodeckxmxlr)=let(a1,l')=goal(a2,x')=fa1kxx(a3,r')=goa2rin(a3,Nodeckxmx'l'r')-- | /O(n)/. The function 'mapAccumR' threads an accumulating-- argument through the map in descending order of keys.mapAccumRWithKey::(a->Intervalk->b->(a,c))->a->IntervalMapkb->(a,IntervalMapkc)mapAccumRWithKeyf=gowheregoaNil=(a,Nil)goa(Nodeckxmxlr)=let(a1,r')=goar(a2,x')=fa1kxx(a3,l')=goa2lin(a3,Nodeckxmx'l'r')-- | /O(n log n)/. @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.-- -- The size of the result may be smaller if @f@ maps two or more distinct-- keys to the same new key. In this case the value at the smallest of-- these keys is retained.mapKeys::Ordk2=>(Intervalk1->Intervalk2)->IntervalMapk1a->IntervalMapk2amapKeysfm=fromList[(fk,v)|(k,v)<-toDescListm]-- | /O(n log n)/. @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.-- -- The size of the result may be smaller if @f@ maps two or more distinct-- keys to the same new key. In this case the associated values will be-- combined using @c@.mapKeysWith::Ordk2=>(a->a->a)->(Intervalk1->Intervalk2)->IntervalMapk1a->IntervalMapk2amapKeysWithcfm=fromListWithc[(fk,v)|(k,v)<-toAscListm]-- | /O(n log n)/. @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@-- is strictly monotonic.-- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.-- /The precondition is not checked./---- This function is currently identical to 'mapKeys', but will eventually be rewritten to have better-- better performance (/O(n)/).mapKeysMonotonic::Ordk2=>(Intervalk1->Intervalk2)->IntervalMapk1a->IntervalMapk2a-- TODO: optimizemapKeysMonotonicfm=mapKeysfm-- | /O(n)/. Filter values satisfying a predicate.filter::Ordk=>(a->Bool)->IntervalMapka->IntervalMapkafilterpm=filterWithKey(\_v->pv)m{-# INLINE filter #-}-- | /O(n)/. Filter keys\/values satisfying a predicate.filterWithKey::Ordk=>(Intervalk->a->Bool)->IntervalMapka->IntervalMapkafilterWithKeypm=mapMaybeWithKey(\kv->ifpkvthenJustvelseNothing)m{-# INLINE filterWithKey #-}-- | /O(n)/. Partition the map according to a predicate. The first-- map contains all elements that satisfy the predicate, the second all-- elements that fail the predicate. See also 'split'.partition::Ordk=>(a->Bool)->IntervalMapka->(IntervalMapka,IntervalMapka)partitionpm=partitionWithKey(\_v->pv)m{-# INLINE partition #-}-- | /O(n)/. Partition the map according to a predicate. The first-- map contains all elements that satisfy the predicate, the second all-- elements that fail the predicate. See also 'split'.partitionWithKey::Ordk=>(Intervalk->a->Bool)->IntervalMapka->(IntervalMapka,IntervalMapka)partitionWithKeypm=mapEitherWithKeyp'mwherep'kv|pkv=Leftv|otherwise=Rightv{-# INLINE partitionWithKey #-}-- | /O(n)/. Map values and collect the 'Just' results.mapMaybe::Ordk=>(a->Maybeb)->IntervalMapka->IntervalMapkbmapMaybefm=mapMaybeWithKey(\_v->fv)m{-# INLINE mapMaybe #-}-- | /O(n)/. Map keys\/values and collect the 'Just' results.mapMaybeWithKey::Ordk=>(Intervalk->a->Maybeb)->IntervalMapka->IntervalMapkbmapMaybeWithKeyfm=fromDistinctAscList(mapf[]m)wheremapfzNil=zmapfz(Node_k_vlr)=mapf(f'kvzr)lf'kvzr=casefkvofNothing->mapfzrJustv'->(k,v'):mapfzr-- | /O(n)/. Map values and separate the 'Left' and 'Right' results.mapEither::Ordk=>(a->Eitherbc)->IntervalMapka->(IntervalMapkb,IntervalMapkc)mapEitherfm=mapEitherWithKey(\_v->fv)m{-# INLINE mapEither #-}-- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.mapEitherWithKey::Ordk=>(Intervalk->a->Eitherbc)->IntervalMapka->(IntervalMapkb,IntervalMapkc)mapEitherWithKeyfm=(fromDistinctAscListl,fromDistinctAscListr)where(l,r)=part[][](toDescListm)partlsrs[]=(ls,rs)partlsrs((k,v):xs)=casefkvofLeftv'->part((k,v'):ls)rsxsRightv'->partls((k,v'):rs)xs-- | /O(n)/. The expression (@'split' k map@) is a pair @(map1,map2)@ where-- the keys in @map1@ are smaller than @k@ and the keys in @map2@ larger than @k@.-- Any key equal to @k@ is found in neither @map1@ nor @map2@.split::Ordk=>Intervalk->IntervalMapka->(IntervalMapka,IntervalMapka)splitxm=(l,r)where(l,_,r)=splitLookupxm{-# INLINE split #-}-- | /O(n)/. The expression (@'splitLookup' k map@) splits a map just-- like 'split' but also returns @'lookup' k map@. splitLookup::Ordk=>Intervalk->IntervalMapka->(IntervalMapka,Maybea,IntervalMapka)splitLookupxm=(fromDistinctAscListless,lookupxm,fromDistinctAscListgreater)whereless=[e|e@(k,_)<-toAscListm,k<x]greater=[e|e@(k,_)<-toAscListm,k>x]-- debugging-- | Check red-black-tree and interval search augmentation invariants.valid::Ordk=>IntervalMapkv->Boolvalidmp=({-# SCC "scc_test" #-}testmp)&&heightmp<=maxHeight(sizemp)&&validColormpwheretestNil=Truetestn@(Node____lr)=validOrdern&&validMaxn&&testl&&testrvalidMax(Node_km_lohi)=m==maxUpperklohivalidMaxNil=TruevalidOrder(Node____NilNil)=TruevalidOrder(Node_k1__Nil(Node_k2____))=k1<k2validOrder(Node_k2__(Node_k1____)Nil)=k1<k2validOrder(Node_k2__(Node_k1____)(Node_k3____))=k1<k2&&k2<k3validOrderNil=True-- validColor parentColor blackCount treevalidColorn={-# SCC "scc_blackDepth" #-}blackDepthn>=0-- return -1 if subtrees have diffrent black depths or two consecutive red nodes are encounteredblackDepth::IntervalMapkv->IntblackDepthNil=0blackDepth(Nodec___lr)=caseblackDepthlofld->ifld<0thenldelsecaseblackDepthrofrd->ifrd<0thenrdelseifrd/=ldthen-1elseifc==R&&(isRedl||isRedr)then-1elseifc==Bthenrd+1elserd