packages feed

int-interval-map (empty) → 0.0.1.0

raw patch · 8 files changed

+712/−0 lines, 8 filesdep +basedep +containersdep +deepseq

Dependencies added: base, containers, deepseq, either, hedgehog, primitive, tasty, tasty-hedgehog, tasty-hunit, tasty-quickcheck, tasty-th, vector, vector-algorithms

Files

+ COPYING view
@@ -0,0 +1,23 @@+Copyright (c) 2020-2021+Luis Pedro Coelho <luis@luispedro.org>++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ ChangeLog view
+ Data/IntervalIntMap.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE FlexibleContexts #-}++module Data.IntervalIntMap+#ifndef IS_BUILDING_TEST+    ( IntervalIntMap+#else+    ( IntervalIntMap(..)+#endif+    , IntervalIntMapAccumulator+    , IM.Interval(..)+    , fromList+    , elems+    , new+    , insert+    , unsafeFreeze+    , lookup+    , map+    , overlaps+    , overlapsWithKeys+    ) where++import Prelude hiding (lookup, map)++import qualified Data.IntervalIntMap.Internal.IntervalIntIntMap as IM+import qualified Data.IntervalIntMap.Internal.GrowableVector as GV+import qualified Data.Vector.Storable as VS+import qualified Data.IntSet as IS+import           Foreign.Storable (Storable(..))+import           Control.Monad.Primitive (PrimMonad, PrimState)+import           Control.Monad (forM_)+import           Control.Monad.ST (runST)+import           Control.Arrow (second)+import           Control.DeepSeq (NFData(..))+++{-| The typical interval map structure models a function of the type @ f :: Int+ - -> Maybe a@. That is, each position in the domain is either annotated by an+ - interval or it is not. When you attempt to insert an interval that overlaps+ - with an existing one, the new value may either (1) replace or (2) by+ - combined with the older one.+ -+ - This is **not** the model here. The model here is @f :: Int -> [a]@! An+ - interval map is a bag of intervals which may overlap. When they do overlap+ - and you query at a position where multiple ones could be active, you get all+ - of them (in some reliable, but unspecified, order; currently insertion+ - order, but this is not an API guarantee).+ -+ - The API uses two objects:+ -+ -  'IntervalIntMapAccumulator': allows insertion. This is a Mutable object and+ -  insertions should be in a `PrimMonad`+ -+ -  'IntervalIntMap': allows querying and operations are pure.+ -+ -}+++data IntervalIntMap a = IntervalIntMap !IM.IntervalIntMap+                                       !(VS.Vector a)+++instance NFData (IntervalIntMap a) where+    rnf (IntervalIntMap im v) = rnf im `seq` rnf v++data IntervalIntMapAccumulator s a = IntervalIntMapAccumulator+                                        !(GV.GrowableVector s (IM.IntervalValue))+                                        !(GV.GrowableVector s a)+++-- |Create an 'IntervalIntMap' from a list of (key, value)+fromList :: Storable a => [(IM.Interval, a)] -> IntervalIntMap a+fromList vs = runST $ do+    acc <- new+    forM_ vs $ \(i,v) -> insert i v acc+    unsafeFreeze acc++elems :: Storable a => IntervalIntMap a -> [a]+elems (IntervalIntMap _ vals) = VS.toList vals++-- |New (empty) accumulator+new :: (PrimMonad m, Storable a) => m (IntervalIntMapAccumulator (PrimState m) a)+new = IntervalIntMapAccumulator <$> GV.new <*> GV.new+++-- |Insert a value into an accumulator+insert :: (PrimMonad m, Storable a) => IM.Interval -> a -> IntervalIntMapAccumulator (PrimState m) a -> m ()+insert (IM.Interval s e) v (IntervalIntMapAccumulator ivs dat) = do+    ix <- GV.length dat+    GV.pushBack v dat+    GV.pushBack (IM.IntervalValue (toEnum s) (toEnum e) (toEnum ix)) ivs+++-- |Transform an 'IntervalIntMapAccumulator' into an 'IntervalIntMap'. This is+--unsafe as the accumulator should **not** be used after this operation is+--performed.+unsafeFreeze :: (PrimMonad m, Storable a) => IntervalIntMapAccumulator (PrimState m) a -> m (IntervalIntMap a)+unsafeFreeze (IntervalIntMapAccumulator ivs values) =+    IntervalIntMap+        <$> (IM.freeze <$> GV.unsafeFreeze ivs)+        <*> GV.unsafeFreeze values++indexAll :: Storable a => VS.Vector a -> IS.IntSet -> [a]+indexAll values = (fmap $ (VS.!) values) . IS.toList++-- |Lookup all values whose keys intersect the given position+lookup ::  Storable a => Int -> IntervalIntMap a -> [a]+lookup p (IntervalIntMap imap values) = indexAll values $ IM.lookup p imap++-- |Map: note that both the input and output types must be instances of+-- Storable, so this is not a functor.+map :: (Storable a, Storable b) => (a -> b) -> IntervalIntMap a -> IntervalIntMap b+map f (IntervalIntMap im vs) = IntervalIntMap im (VS.map f vs)++-- |Lookup all values that overlap with the given input+overlaps :: Storable a => IM.Interval -> IntervalIntMap a -> [a]+overlaps i = fmap snd . overlapsWithKeys i++-- |Lookup all values that overlap with the given input+overlapsWithKeys :: Storable a => IM.Interval -> IntervalIntMap a -> [(IM.Interval,a)]+overlapsWithKeys i (IntervalIntMap imap values) = fmap (second $ (VS.!) values) $ IM.overlapsWithKeys i imap+
+ Data/IntervalIntMap/Internal/GrowableVector.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE FlexibleContexts #-}++module Data.IntervalIntMap.Internal.GrowableVector+    ( GrowableVector+    , GrowableVectorData(..)+    , new+    , pushBack+    , unsafeFreeze+    , length+    ) where++import Prelude hiding (length)++import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Storable.Mutable as VSM+import           Foreign.Storable (Storable(..))+import           Control.Monad.Primitive (PrimMonad, PrimState)+import           Data.Primitive.MutVar (MutVar, newMutVar, readMutVar, writeMutVar)++{--| This is a growable vector (i.e., one that includes the 'pushBack'+ - function) which must exist in a 'PrimMonad'. It only supports Storable data+ - items.+ -}+++type GrowableVector s a = MutVar s (GrowableVectorData s a)++data GrowableVectorData s a = GrowableVectorData !Int !(VSM.MVector s a)++-- | Empty vector+new :: (PrimMonad m, Storable a) => m (GrowableVector (PrimState m) a)+new = do+    vd <- GrowableVectorData 0 <$> VSM.unsafeNew 16+    newMutVar vd++-- | Insert an element at the end of the vector+pushBack :: (PrimMonad m, Storable a) => a -> GrowableVector (PrimState m) a -> m ()+pushBack val gv =+    readMutVar gv >>= pushBack' val >>= writeMutVar gv++pushBack' :: (PrimMonad m, Storable a) => a -> GrowableVectorData (PrimState m) a -> m (GrowableVectorData (PrimState m) a)+pushBack' val (GrowableVectorData used vec)+    | used == VSM.length vec = do+        vec' <- VSM.grow vec (VSM.length vec `div` 2) -- multiplying by 1.5 is close to optimal+        pushBack' val (GrowableVectorData  used vec')+    | otherwise = do+        VSM.write vec used val+        return $! GrowableVectorData (used+1) vec++-- | This operation is unsafe as original vector should not be used again!+unsafeFreeze :: (PrimMonad m, Storable a) => GrowableVector (PrimState m) a -> m (VS.Vector a)+unsafeFreeze gv = do+    GrowableVectorData used vec <- readMutVar gv+    VS.take used <$> VS.unsafeFreeze vec++-- | Return the current number of stored elements+length :: (PrimMonad m, Storable a) => GrowableVector (PrimState m) a -> m Int+length gv = do+    GrowableVectorData len _ <- readMutVar gv+    return len
+ Data/IntervalIntMap/Internal/IntervalIntIntMap.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE FlexibleContexts, TypeApplications #-}++module Data.IntervalIntMap.Internal.IntervalIntIntMap+    ( IntervalValue(..)+    , Interval(..)+    , IntervalIntMap+    , naiveIntervalMapLookup+    , lookup+    , overlaps+    , overlapsWithKeys+    , naiveOverlaps+    , naiveOverlapsWithKeys+    , NaiveIntervalInt+    , intervalContains+    , partition+    , freeze+#ifdef IS_BUILDING_TEST+    , mkTree+#endif+    ) where+import Prelude hiding (lookup)++import qualified Data.IntervalIntMap.Internal.GrowableVector as GV++import qualified Foreign.Storable as FS+import           Foreign.Ptr (castPtr, plusPtr)+import qualified Data.Set as S+import qualified Data.IntSet as IS+import qualified Data.Vector.Storable as VS+import           Control.Monad.ST (runST)+import           Data.Word (Word32)+import           Data.Ord (comparing)+import           Data.Vector.Algorithms.Tim (sortBy)+import           Control.DeepSeq (NFData(..))+++{- DATA STRUCTURE+ -+ - An IntervalValue contains the interval [ivStart, ivPast) and the value. This+ - is a closed-open interval, so represents `x` such that `ivStart <= x <+ - ivPast`.+ -+ - The simplest map is the NaiveIntervalInt, which is just a vector. It is very+ - memory efficient, but needs O(N) to search. However, for small N, it is+ - likely very efficient and we can use this "structure" for testing too.+ -+ - The Tree is very simple: At each node, there is a split value and intervals+ - are completely below it, completely above it, or contain the point.+ -+ -+ - Leafs contain NaiveIntervalInt+ -}+++data Interval = Interval !Int !Int+#ifdef IS_BUILDING_TEST+                            deriving (Eq, Show)+#endif++data IntervalValue = IntervalValue+                        { ivStart :: !Word32+                        , ivPast :: !Word32+                        , ivValue :: !Word32+                        }+#ifdef IS_BUILDING_TEST+                              deriving (Show)+#endif++instance Eq IntervalValue where+    (IntervalValue s0 e0 ix0) == (IntervalValue s1 e1 ix1) =+            s0 == s1 && e0 == e1 && ix0 == ix1++-- This is necessary to build sets of 'IntervalValue's (e.g., in 'naiveOverlapsWithKeys')+instance Ord IntervalValue where+    (IntervalValue s0 e0 ix0) `compare` (IntervalValue s1 e1 ix1)+        | s0 /= s1 = s0 `compare` s1+        | e0 /= e1 = e0 `compare` e1+        | otherwise = ix0 `compare` ix1++instance FS.Storable IntervalValue where+    sizeOf _ = 3 * 4 -- aka 12+    alignment x = FS.alignment (ivStart x)+    peek p = IntervalValue+                    <$> FS.peek (castPtr p)+                    <*> FS.peek (castPtr p `plusPtr` 4)+                    <*> FS.peek (castPtr p `plusPtr` 8)+    poke ptr (IntervalValue s p v) = do+        let ptr' = castPtr ptr+        FS.pokeElemOff @Word32 ptr' 0 s+        FS.pokeElemOff @Word32 ptr' 1 p+        FS.pokeElemOff @Word32 ptr' 2 v++intervalContains :: Int -> IntervalValue -> Bool+intervalContains p (IntervalValue s e _) =+    let p' = toEnum p+    in s <= p' && p' < e++type NaiveIntervalInt = VS.Vector IntervalValue++data IntervalIntMapNode = Leaf NaiveIntervalInt+                        | InnerNode+                            { _nodeSplitValue :: !Int+                            , _leftSplit :: !IntervalIntMapNode+                            , _centerSplit :: !IntervalIntMapNode+                            , _rightSplit :: !IntervalIntMapNode+                            }+#ifdef IS_BUILDING_TEST+                              deriving (Show)+#endif++instance NFData IntervalIntMapNode where+    rnf (Leaf v) = rnf v+    rnf (InnerNode !_ left center right) = rnf left `seq` rnf center `seq` rnf right++newtype IntervalIntMap = IntervalIntMap { _imapRoot :: IntervalIntMapNode }+#ifdef IS_BUILDING_TEST+                              deriving (Show)+#endif++instance NFData IntervalIntMap where+    rnf (IntervalIntMap !n) = rnf n++partition :: Int -> NaiveIntervalInt -> (NaiveIntervalInt, NaiveIntervalInt, NaiveIntervalInt)+partition p vec = runST $ do+    left <- GV.new+    center <- GV.new+    right <- GV.new+    VS.forM_ vec $ \val ->+        let target+                | ivPast val <= toEnum p = left+                | ivStart val > toEnum p = right+                | otherwise = center+        in GV.pushBack val target+    (,,)+        <$> GV.unsafeFreeze left+        <*> GV.unsafeFreeze center+        <*> GV.unsafeFreeze right+++sortedByEnd :: NaiveIntervalInt -> NaiveIntervalInt+sortedByEnd vec = VS.create $ do+    vec' <- VS.thaw vec+    sortBy (comparing ivPast) vec'+    return vec'++{-|+  Turn a 'NaiveIntervalInt' into an 'IntervalIntMap'+-}+freeze :: NaiveIntervalInt -> IntervalIntMap+freeze = mkTree 16++mkTree :: Int -> NaiveIntervalInt -> IntervalIntMap+mkTree maxSplit vec = IntervalIntMap $ mkTree' 0 maxSplit (sortedByEnd vec)++maxSplitIters :: Int+maxSplitIters = 8++mkTree' nIters maxSplit vec+    | VS.length vec <= maxSplit = Leaf vec+    | nIters > maxSplitIters = Leaf vec+    | otherwise = trySplit nIters maxSplit vec++trySplit nIters maxSplit vec = InnerNode (fromEnum p) (r left) (r center) (r right)+    where+        r = mkTree' nIters' maxSplit+        (left, center, right) = partition (fromEnum p) vec+        nIters'+            | successful = 0+            | otherwise = nIters + 1++        -- The criterion for calling it a successful split is a bit random, but seems to work:+        -- If after splitting the largest component is at least maxSplit+        -- smaller than the input, that was a successful split+        successful = VS.length vec - maximum (map VS.length [left, center, right]) >= maxSplit++        -- Choosing a pivot will probably have a big impact on the performance.+        -- We pick the median end-point one, which is probably a decent heuristic+        p = ivPast $ (VS.!) vec (VS.length vec `div` 2)++lookup :: Int -> IntervalIntMap -> IS.IntSet+lookup x (IntervalIntMap root) = lookup' root+    where++        lookup' (Leaf vec) = naiveIntervalMapLookup x vec+        lookup' (InnerNode p left center right)+            | x < p = lookup' left `IS.union` lookup' center+            | x == p = lookup' center+            | otherwise = lookup' center `IS.union` lookup' right++naiveIntervalMapLookup :: Int -> NaiveIntervalInt -> IS.IntSet+naiveIntervalMapLookup x = IS.fromList . VS.toList . VS.map (fromEnum . ivValue) . VS.filter (intervalContains x)++naiveOverlaps :: Interval -> NaiveIntervalInt -> IS.IntSet+naiveOverlaps i = IS.fromList . map snd . naiveOverlapsWithKeys i++naiveOverlapsWithKeys :: Interval -> NaiveIntervalInt -> [(Interval, Int)]+naiveOverlapsWithKeys i = map asPair . S.toList . naiveOverlapsWithKeys' i++asPair (IntervalValue s e ix) = (Interval (fromEnum s) (fromEnum e), fromEnum ix)++naiveOverlapsWithKeys' :: Interval -> NaiveIntervalInt -> S.Set IntervalValue+naiveOverlapsWithKeys' (Interval s0 e0) = S.fromList . VS.toList . VS.filter overlap1+    where+        overlap1 (IntervalValue s1' e1' _)+            | s0 == e0 = False+            | s1' == e1' = False+            | otherwise =+                let+                    s1 = fromEnum s1'+                    e1 = fromEnum e1'+                in (s0 <= s1 && s1 < e0) || (s1 <= s0 && s0 < e1)++overlaps :: Interval -> IntervalIntMap -> IS.IntSet+overlaps i (IntervalIntMap root) = overlaps' i root++overlaps' i (Leaf vec) = naiveOverlaps i vec+overlaps' i (InnerNode p left centre right)+    | i `intervalAbove` p = overlaps'  i right `IS.union` overlaps' i centre+    | i `intervalBelow` p = overlaps' i left `IS.union` overlaps' i centre+    | otherwise = overlaps' i left `IS.union` overlaps' i centre `IS.union` overlaps' i right++overlapsWithKeys :: Interval -> IntervalIntMap -> [(Interval, Int)]+overlapsWithKeys i (IntervalIntMap root) = map asPair . S.toList $ overlapsWithKeys' i root++overlapsWithKeys' :: Interval -> IntervalIntMapNode -> S.Set IntervalValue+overlapsWithKeys' i (Leaf vec) = naiveOverlapsWithKeys' i vec+overlapsWithKeys' i (InnerNode p left centre right)+    | i `intervalAbove` p = overlapsWithKeys'  i right `S.union` overlapsWithKeys' i centre+    | i `intervalBelow` p = overlapsWithKeys' i left `S.union` overlapsWithKeys' i centre+    | otherwise = overlapsWithKeys' i left `S.union` overlapsWithKeys' i centre `S.union` overlapsWithKeys' i right++intervalAbove (Interval s _) p = s > p+intervalBelow (Interval _ e) p = e <= p+
+ README.md view
@@ -0,0 +1,63 @@+# IntervalIntMap++An interval map structure that is optimized for low memory (each interval is+represented by about 3 words + whatever the cargo is) and has semantics that+are appropriate for genomic intervals (namely, intervals can overlap and+queries will return **all** matches together). It also designed to be used in+two phases: a construction phase + query phase).++This is not a general purpose package, it serves mostly as support for+[NGLess](https://ngless.embl.de) and is used there.++Do get [in touch](mailto:luis@luispedro.org) if you want to use it more+generally, but the plans for this repo is to develop it only in so far as it+helps with NGLess' goals.++## Example Usage++### Step 1: construction++In the first phase, an `IntervalIntMapAccumulator` accumulator is used. This is+a mutable object and it must be used inside a `PrimMonad` (typically either+`IO` or `ST s`). Elements can be inserted into this object.++```haskell+import qualified Data.IntervalIntMap as IM++insertMany :: [(Int, Int)] -> IO (IM.IntervalIntMap Int)+insertMany elems = do+    acc <- IM.new+    forM_ (zip elems [0..]) $ \((s,p), ix) ->+        IM.insert (IM.Interval s p) ix+    IM.unsafeFreeze acc+```++The final step in _construction_ is freezing the accumulator to produce a+`IntervalIntMap`. If the original accumulator is not to be used again, then+`unsafeFreeze` can be used.++### Step 2: usage++The `IntervalIntMap` object is a pure object, with the typical container+functions: `map`, `lookup`, `elems`,...++Do note that the signature for `lookup` is++```haskell+lookup ::  Storable a => Int -> IntervalIntMap a -> [a]+```++Thus, a list is always returned: `[]` if nothing is found, but multiple+intervals can independently overlap with the query.++## Citation++If you do use this repository, please cite the main [NGLess](https://ngless.embl.de) paper:++> _NG-meta-profiler: fast processing of metagenomes using NGLess, a+> domain-specific language_ by Luis Pedro Coelho, Renato Alves, Paulo Monteiro,+> Jaime Huerta-Cepas, Ana Teresa Freitas, Peer Bork, Microbiome (2019)+> [https://doi.org/10.1186/s40168-019-0684-8](https://doi.org/10.1186/s40168-019-0684-8)++LICENSE: MIT+
+ int-interval-map.cabal view
@@ -0,0 +1,87 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack+--+-- hash: a6fd4a2bc6feee2444e88bd5e1d7922a8a860bdf846ee75842b6d97fd876b9a9++name:           int-interval-map+version:        0.0.1.0+synopsis:       Interval map+description:    Interval map with support for overlapping intervals+category:       Data+homepage:       https://github.com/ngless-toolkit/interval-to-int#readme+bug-reports:    https://github.com/ngless-toolkit/interval-to-int/issues+author:         Luis Pedro Coelho+maintainer:     luis@luispedro.org+license:        MIT+license-file:   COPYING+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog++source-repository head+  type: git+  location: https://github.com/ngless-toolkit/interval-to-int++library+  exposed-modules:+      Data.IntervalIntMap+  other-modules:+      Data.IntervalIntMap.Internal.GrowableVector+      Data.IntervalIntMap.Internal.IntervalIntIntMap+  hs-source-dirs:+      ./+  default-extensions:+      BangPatterns+      OverloadedStrings+      LambdaCase+      TupleSections+      CPP+  ghc-options: -Wall -Wcompat -fwarn-tabs -fno-warn-missing-signatures -O2+  build-depends:+      base >=4.12 && <4.16+    , containers+    , deepseq+    , either+    , primitive+    , vector+    , vector-algorithms+  default-language: Haskell2010++test-suite interval-int-map-test+  type: exitcode-stdio-1.0+  main-is: Tests.hs+  other-modules:+      Data.IntervalIntMap+      Data.IntervalIntMap.Internal.GrowableVector+      Data.IntervalIntMap.Internal.IntervalIntIntMap+      Paths_int_interval_map+  hs-source-dirs:+      ./+      ./tests+  default-extensions:+      BangPatterns+      OverloadedStrings+      LambdaCase+      TupleSections+      CPP+  ghc-options: -Wall -Wcompat -fwarn-tabs -fno-warn-missing-signatures -O2+  cpp-options: -DIS_BUILDING_TEST+  build-depends:+      base >=4.12 && <4.16+    , containers+    , deepseq+    , either+    , hedgehog+    , primitive+    , tasty+    , tasty-hedgehog+    , tasty-hunit+    , tasty-quickcheck+    , tasty-th+    , vector+    , vector-algorithms+  default-language: Haskell2010
+ tests/Tests.hs view
@@ -0,0 +1,124 @@+{- Copyright 2020 Luis Pedro Coelho+ - License: MIT+ -}+{-# LANGUAGE TemplateHaskell, QuasiQuotes, FlexibleContexts #-}+module Main where++import Test.Tasty.HUnit+import Test.Tasty.TH (defaultMainGenerator)+import qualified Hedgehog as H+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Test.Tasty.Hedgehog++++import qualified Data.Vector.Storable as VS+import qualified Data.IntervalIntMap as IMA+import qualified Data.IntervalIntMap.Internal.IntervalIntIntMap as IM+import qualified Data.IntervalIntMap.Internal.GrowableVector as GV+import           Data.Foldable (forM_, for_)+import qualified Data.IntSet as IS+++tData =+    [ IM.IntervalValue 0  2 0+    , IM.IntervalValue 0  2 1+    , IM.IntervalValue 1  2 2+    , IM.IntervalValue 3  6 3+    , IM.IntervalValue 3  4 4+    , IM.IntervalValue 1  4 5+    , IM.IntervalValue 4  7 6+    , IM.IntervalValue 4  6 7+    , IM.IntervalValue 8 10 8+    , IM.IntervalValue 1 12 9+    ]++tDataN :: IM.NaiveIntervalInt+tDataN = VS.fromList tData++below x (IM.IntervalValue _ e _) = x >= e+above x (IM.IntervalValue s _ _) = x < s++case_partition =+    for_ [0..14] $ \split -> do+        let (left,center,right) = IM.partition split tDataN+        all (below $ toEnum split) (VS.toList left) @? "Center does not include split"+        all (IM.intervalContains $ toEnum split) (VS.toList center) @? "Left is not below split"+        all (above $ toEnum split) (VS.toList right) @? "Right is not above split"+        VS.length left + VS.length center + VS.length right @=? VS.length tDataN++case_small_build_tree_find = do+    let t = IM.mkTree 4 tDataN+    for_ [0..14] $ \x ->+        IM.lookup x t @=? IM.naiveIntervalMapLookup x tDataN++genSimpleInterval space = do+    s <- Gen.integral (Range.linear 0 space)+    len <- Gen.integral (Range.linear 0 space)+    return (s, s + len)++prop_build_tree_find = H.property $ do+    -- the smaller values will generate more crowded inputs+    space <- H.forAll $ Gen.integral (Range.linear 100 2000)+    intervals <- H.forAll $ Gen.list (Range.linear 0 2000) $ genSimpleInterval space+    ps <- H.forAll $ Gen.list (Range.linear 0 5) $ Gen.integral $ Range.linear 0 10000+    H.classify "empty" $ length intervals == 0+    H.classify "small (N< 100)" $ length intervals < 100+    H.classify "large (N>=100)" $ length intervals >= 100+    let naive = VS.fromList [IM.IntervalValue s e ix | ((s,e),ix) <- zip intervals [0..]]+        t = IM.mkTree 16 naive+    for_ ps $ \p ->+        IM.lookup p t H.=== IM.naiveIntervalMapLookup p naive++++prop_naive_overlaps1 = H.property $ do+    (s,e) <- H.forAll $ genSimpleInterval 100+    (s',e') <- H.forAll $ genSimpleInterval 100+    let naive = VS.fromList [IM.IntervalValue (toEnum s) (toEnum e) 0]+        i = IM.Interval s' e'+        doesOverlap+            | s >= e = False+            | otherwise = any (\c -> s' <= c && c < e') [s..(e-1)]+    H.classify "empty interval" $ s == e || s' == e'+    H.classify "overlaps" $ doesOverlap+    H.classify "no overlap" $ not doesOverlap+    (not . IS.null $ IM.naiveOverlaps i naive) H.=== doesOverlap++prop_growable_vector = H.property $ do+    values <- H.forAll $ Gen.list (Range.linear 0 1000) $ Gen.integral (Range.linear 0 1000)+    let direct = VS.fromList (values :: [Int])+    built <- do+        gv <- GV.new+        forM_ values (`GV.pushBack` gv)+        GV.unsafeFreeze gv+    direct H.=== built++case_simple_ima = do+    acc <- IMA.new+    IMA.insert (IMA.Interval 2 4) (7 :: Int) acc+    IMA.insert (IMA.Interval 3 6) (8 :: Int) acc+    im <- IMA.unsafeFreeze acc+    IMA.lookup 1 im @=? []+    IMA.lookup 2 im @=? [7]+    IS.fromList (IMA.lookup 3 im) @=? IS.fromList [7,8]+    IMA.lookup 4 im @=? [8]+    (length $ IMA.overlaps (IMA.Interval 2 5) im) @=? 2+    (length $ IMA.overlapsWithKeys (IMA.Interval 2 5) im) @=? 2++    (length $ IMA.overlaps (IMA.Interval 4 5) im) @=? 1+    (length $ IMA.overlapsWithKeys (IMA.Interval 4 5) im) @=? 1++    (length $ IMA.overlaps (IMA.Interval 4 9) im) @=? 1+    (length $ IMA.overlapsWithKeys (IMA.Interval 4 9) im) @=? 1++case_fromList = do+    let im = IMA.fromList [(IMA.Interval (fromEnum s) (fromEnum e), v) | (IM.IntervalValue s e v) <- tData]+    IMA.overlapsWithKeys (IM.Interval 11 15)  im @?= [(IM.Interval 1 12, 9)]+++main :: IO ()+main = $(defaultMainGenerator)++