{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE CPP, BangPatterns, TupleSections #-}
{-# LANGUAGE Safe #-}
module Data.IntervalMap.Strict
(
IntervalMap
, module Data.ExtendedReal
, (!)
, (\\)
, null
, member
, notMember
, lookup
, findWithDefault
, span
, whole
, empty
, singleton
, insert
, insertWith
, delete
, adjust
, update
, alter
, union
, unionWith
, unions
, unionsWith
, intersection
, intersectionWith
, difference
, map
, mapKeysMonotonic
, elems
, keys
, assocs
, keysSet
, fromList
, fromListWith
, toList
, toAscList
, toDescList
, filter
, split
, isSubmapOf
, isSubmapOfBy
, isProperSubmapOf
, isProperSubmapOfBy
)
where
import Prelude hiding (null, lookup, map, filter, span)
import Data.ExtendedReal
import Data.Interval (Interval)
import qualified Data.Interval as Interval
import Data.IntervalMap.Base hiding
( whole
, singleton
, insert
, insertWith
, adjust
, update
, alter
, unionWith
, unionsWith
, intersectionWith
, map
, fromList
, fromListWith
)
import qualified Data.IntervalMap.Base as B
import qualified Data.IntervalSet as IntervalSet
import Data.List (foldl')
import qualified Data.Map.Strict as Map
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
whole :: Ord k => a -> IntervalMap k a
whole !a = B.whole a
singleton :: Ord k => Interval k -> a -> IntervalMap k a
singleton i !a = B.singleton i a
insert :: Ord k => Interval k -> a -> IntervalMap k a -> IntervalMap k a
insert i !a m = B.insert i a m
insertWith :: Ord k => (a -> a -> a) -> Interval k -> a -> IntervalMap k a -> IntervalMap k a
insertWith _ i _ m | Interval.null i = m
insertWith f i !a m = alter g i m
where
g Nothing = Just a
g (Just a') = Just $! f a a'
adjust :: Ord k => (a -> a) -> Interval k -> IntervalMap k a -> IntervalMap k a
adjust f = update (Just . f)
update :: Ord k => (a -> Maybe a) -> Interval k -> IntervalMap k a -> IntervalMap k a
update _ i m | Interval.null i = m
update f i m =
case split i m of
(IntervalMap m1, IntervalMap m2, IntervalMap m3) ->
IntervalMap $ Map.unions [m1, Map.mapMaybe (\(j,a) -> (\b -> seq b (j,b)) <$> f a) m2, m3]
alter :: Ord k => (Maybe a -> Maybe a) -> Interval k -> IntervalMap k a -> IntervalMap k a
alter _ i m | Interval.null i = m
alter f i m =
case split i m of
(IntervalMap m1, IntervalMap m2, IntervalMap m3) ->
let m2' = Map.mapMaybe (\(j,a) -> (\b -> seq b (j,b)) <$> f (Just a)) m2
js = IntervalSet.singleton i `IntervalSet.difference` keysSet (IntervalMap m2)
IntervalMap m2'' =
case f Nothing of
Nothing -> empty
Just !a -> B.fromList [(j,a) | j <- IntervalSet.toList js]
in seq m2' $ IntervalMap $ Map.unions [m1, m2', m2'', m3]
unionWith :: Ord k => (a -> a -> a) -> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
unionWith f m1 m2 =
foldl' (\m (i,a) -> insertWith f i a m) m2 (toList m1)
unionsWith :: Ord k => (a -> a -> a) -> [IntervalMap k a] -> IntervalMap k a
unionsWith f = foldl' (unionWith f) empty
intersectionWith :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
intersectionWith f im1@(IntervalMap m1) im2@(IntervalMap m2)
| Map.size m1 >= Map.size m2 = g f im1 im2
| otherwise = g (flip f) im2 im1
where
g :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
g h jm1 (IntervalMap m3) = IntervalMap $ Map.unions $ go jm1 (Map.elems m3)
where
go _ [] = []
go im ((i,b) : xs) =
case split i im of
(_, IntervalMap m, jm2) ->
Map.map (\(j, a) -> (j,) $! h a b) m : go jm2 xs
map :: (a -> b) -> IntervalMap k a -> IntervalMap k b
map f (IntervalMap m) = IntervalMap $ Map.map (\(i, a) -> (i,) $! f a) m
fromList :: Ord k => [(Interval k, a)] -> IntervalMap k a
fromList = foldl' (\m (i,a) -> insert i a m) empty
fromListWith :: Ord k => (a -> a -> a) -> [(Interval k, a)] -> IntervalMap k a
fromListWith f = foldl' (\m (i,a) -> insertWith f i a m) empty