closed-intervals 0.2.0.0 → 0.2.0.1
raw patch · 5 files changed
+212/−190 lines, 5 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Data.Interval: fromEndPoints :: (Ord e) => [e] -> Seq (e, e)
+ Data.Interval: fromEndPoints :: Ord e => [e] -> Seq (e, e)
- Data.Interval: hullOfTree :: (Interval e i) => ITree e i -> Maybe (e, e)
+ Data.Interval: hullOfTree :: Interval e i => ITree e i -> Maybe (e, e)
- Data.Interval: sortByRight :: (Interval e i) => Seq i -> Seq i
+ Data.Interval: sortByRight :: Interval e i => Seq i -> Seq i
Files
- ChangeLog.md +5/−0
- closed-intervals.cabal +4/−5
- doctest/Test/Data/Interval.hs +176/−175
- src/Data/Interval.hs +11/−2
- test/Data/IntervalTest.hs +16/−8
ChangeLog.md view
@@ -14,4 +14,9 @@ Removed the low-level functions findSeq and existsSeq from the API because they do not suggest the assumptions made. +- 0.2.0.1 updated the documentation of NonNestedSeq and + improved the test case generation of sequences of non-nested intervals. + Replaced Data.List.isSubsequencOf by a custom relation that + reflects our intention to check for contiguous subsequences. + ## Unreleased changes
closed-intervals.cabal view
@@ -1,7 +1,7 @@ cabal-version: 1.12 name: closed-intervals-version: 0.2.0.0+version: 0.2.0.1 synopsis: Closed intervals of totally ordered types description: see README.md author: Olaf Klinke, Henning Thielemann@@ -53,7 +53,6 @@ other-modules: Test.Data.Interval --- internal use only--- source-repository head--- type: svn--- location: svn://192.168.4.220/closed-intervals+source-repository head+ type: darcs+ location: https://hub.darcs.net/olf/closed-intervals
doctest/Test/Data/Interval.hs view
@@ -16,309 +16,310 @@ import Data.Foldable (toList) import Test.QuickCheck ((==>)) without' :: (Int,Int) -> (Int,Int) -> [(Int,Int)]; without' = without+isSubsequenceOf :: Eq a => [a] -> [a] -> Bool; isSubsequenceOf [] _ = True; isSubsequenceOf (_:_) [] = False; isSubsequenceOf xs@(x:xs') (y:ys) = (x == y && xs' `List.isPrefixOf` ys) || xs `isSubsequenceOf` ys test :: DocTest.T () test = do- DocTest.printPrefix "Data.Interval:181: "-{-# LINE 181 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:189: "+{-# LINE 189 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 181 "src/Data/Interval.hs" #-}+{-# LINE 189 "src/Data/Interval.hs" #-} (forevery genNonNestedIntervalSeq $ \xs -> propSplit (\subseq -> hullSeqNonNested subseq == hullSeq subseq) (splitSeq xs))- DocTest.printPrefix "Data.Interval:176: "-{-# LINE 176 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:177: "+{-# LINE 177 "src/Data/Interval.hs" #-} DocTest.example-{-# LINE 176 "src/Data/Interval.hs" #-}+{-# LINE 177 "src/Data/Interval.hs" #-} (propSplit (\xs -> hullSeqNonNested xs == hullSeq xs) . splitSeq . sortByRight $ Seq.fromList ([(1,3),(2,4),(4,5),(3,6)] :: [(Int,Int)])) [ExpectedLine [LineChunk "False"]]- DocTest.printPrefix "Data.Interval:229: "-{-# LINE 229 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:237: "+{-# LINE 237 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 229 "src/Data/Interval.hs" #-}+{-# LINE 237 "src/Data/Interval.hs" #-} (forevery genInterval $ \i -> overlapTime i i == intervalDuration i)- DocTest.printPrefix "Data.Interval:230: "-{-# LINE 230 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:238: "+{-# LINE 238 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 230 "src/Data/Interval.hs" #-}+{-# LINE 238 "src/Data/Interval.hs" #-} (foreveryPair genInterval $ \i j -> not (i `properlyIntersects` j) ==> overlapTime i j == 0)- DocTest.printPrefix "Data.Interval:231: "-{-# LINE 231 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:239: "+{-# LINE 239 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 231 "src/Data/Interval.hs" #-}+{-# LINE 239 "src/Data/Interval.hs" #-} (foreveryPair genInterval $ \i j -> overlapTime i j == (sum $ fmap intervalDuration $ maybeIntersection i j))- DocTest.printPrefix "Data.Interval:241: "-{-# LINE 241 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:249: "+{-# LINE 249 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 241 "src/Data/Interval.hs" #-}+{-# LINE 249 "src/Data/Interval.hs" #-} (forevery genInterval $ \i c -> prevailing i (Seq.singleton (c,i)) == Just (c::Char))- DocTest.printPrefix "Data.Interval:242: "-{-# LINE 242 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:250: "+{-# LINE 250 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 242 "src/Data/Interval.hs" #-}+{-# LINE 250 "src/Data/Interval.hs" #-} (foreveryPairOf genInterval genLabeledSeq $ \i js -> isJust (prevailing i js) == any (intersects i . snd) js)- DocTest.printPrefix "Data.Interval:243: "-{-# LINE 243 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:251: "+{-# LINE 251 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 243 "src/Data/Interval.hs" #-}+{-# LINE 251 "src/Data/Interval.hs" #-} (forevery genInterval $ \i -> foreveryPair genLabeledSeq $ \js ks -> all (flip elem $ catMaybes [prevailing i js, prevailing i ks]) $ prevailing i (js<>ks))- DocTest.printPrefix "Data.Interval:266: "-{-# LINE 266 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:274: "+{-# LINE 274 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 266 "src/Data/Interval.hs" #-}+{-# LINE 274 "src/Data/Interval.hs" #-} (foreveryPair genInterval $ \i j -> isJust (maybeUnion i j) ==> fromJust (maybeUnion i j) `contains` i && fromJust (maybeUnion i j) `contains` j)- DocTest.printPrefix "Data.Interval:267: "-{-# LINE 267 "src/Data/Interval.hs" #-}- DocTest.property-{-# LINE 267 "src/Data/Interval.hs" #-}- (foreveryPair genInterval $ \i j -> i `intersects` j ==> (maybeUnion i j >>= maybeIntersection i) == Just i) DocTest.printPrefix "Data.Interval:275: " {-# LINE 275 "src/Data/Interval.hs" #-} DocTest.property {-# LINE 275 "src/Data/Interval.hs" #-}- (foreveryPair genInterval $ \i j -> i `intersects` j ==> i `contains` fromJust (maybeIntersection i j))+ (foreveryPair genInterval $ \i j -> i `intersects` j ==> (maybeUnion i j >>= maybeIntersection i) == Just i) DocTest.printPrefix "Data.Interval:283: " {-# LINE 283 "src/Data/Interval.hs" #-} DocTest.property {-# LINE 283 "src/Data/Interval.hs" #-}+ (foreveryPair genInterval $ \i j -> i `intersects` j ==> i `contains` fromJust (maybeIntersection i j))+ DocTest.printPrefix "Data.Interval:291: "+{-# LINE 291 "src/Data/Interval.hs" #-}+ DocTest.property+{-# LINE 291 "src/Data/Interval.hs" #-} (\xs -> isJust (hull xs) ==> all (\x -> fromJust (hull xs) `contains` x) (xs :: [(Int,Int)]))- DocTest.printPrefix "Data.Interval:300: "-{-# LINE 300 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:308: "+{-# LINE 308 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 300 "src/Data/Interval.hs" #-}+{-# LINE 308 "src/Data/Interval.hs" #-} (foreveryPair genInterval $ \i j -> length (i `without` j) <= 2)- DocTest.printPrefix "Data.Interval:301: "-{-# LINE 301 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:309: "+{-# LINE 309 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 301 "src/Data/Interval.hs" #-}+{-# LINE 309 "src/Data/Interval.hs" #-} (forevery genInterval $ \i -> i `without` i == [])- DocTest.printPrefix "Data.Interval:302: "-{-# LINE 302 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:310: "+{-# LINE 310 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 302 "src/Data/Interval.hs" #-}+{-# LINE 310 "src/Data/Interval.hs" #-} (foreveryPair genInterval $ \i j -> all (contains i) (i `without` j))- DocTest.printPrefix "Data.Interval:303: "-{-# LINE 303 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:311: "+{-# LINE 311 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 303 "src/Data/Interval.hs" #-}+{-# LINE 311 "src/Data/Interval.hs" #-} (foreveryPair genInterval $ \i j -> not $ any (properlyIntersects j) (i `without` j))- DocTest.printPrefix "Data.Interval:291: "-{-# LINE 291 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:299: "+{-# LINE 299 "src/Data/Interval.hs" #-} DocTest.example-{-# LINE 291 "src/Data/Interval.hs" #-}+{-# LINE 299 "src/Data/Interval.hs" #-} (without' (1,5) (4,5)) [ExpectedLine [LineChunk "[(1,4)]"]]- DocTest.printPrefix "Data.Interval:293: "-{-# LINE 293 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:301: "+{-# LINE 301 "src/Data/Interval.hs" #-} DocTest.example-{-# LINE 293 "src/Data/Interval.hs" #-}+{-# LINE 301 "src/Data/Interval.hs" #-} (without' (1,5) (2,3)) [ExpectedLine [LineChunk "[(1,2),(3,5)]"]]- DocTest.printPrefix "Data.Interval:295: "-{-# LINE 295 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:303: "+{-# LINE 303 "src/Data/Interval.hs" #-} DocTest.example-{-# LINE 295 "src/Data/Interval.hs" #-}+{-# LINE 303 "src/Data/Interval.hs" #-} (without' (1,5) (1,5)) [ExpectedLine [LineChunk "[]"]]- DocTest.printPrefix "Data.Interval:297: "-{-# LINE 297 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:305: "+{-# LINE 305 "src/Data/Interval.hs" #-} DocTest.example-{-# LINE 297 "src/Data/Interval.hs" #-}+{-# LINE 305 "src/Data/Interval.hs" #-} (without' (1,5) (0,1)) [ExpectedLine [LineChunk "[(1,5)]"]]- DocTest.printPrefix "Data.Interval:319: "-{-# LINE 319 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:327: "+{-# LINE 327 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 319 "src/Data/Interval.hs" #-}+{-# LINE 327 "src/Data/Interval.hs" #-} (forevery genSortedIntervals $ all (\xs -> and $ List.zipWith intersects xs (tail xs)) . contiguous)- DocTest.printPrefix "Data.Interval:320: "-{-# LINE 320 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:328: "+{-# LINE 328 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 320 "src/Data/Interval.hs" #-}+{-# LINE 328 "src/Data/Interval.hs" #-} (forevery genSortedIntervals $ all ((1==).length.components) . contiguous)- DocTest.printPrefix "Data.Interval:335: "-{-# LINE 335 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:343: "+{-# LINE 343 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 335 "src/Data/Interval.hs" #-}+{-# LINE 343 "src/Data/Interval.hs" #-} (forevery genSortedIntervals $ \xs -> all (\i -> any (flip contains i) (components xs)) xs)- DocTest.printPrefix "Data.Interval:336: "-{-# LINE 336 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:344: "+{-# LINE 344 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 336 "src/Data/Interval.hs" #-}+{-# LINE 344 "src/Data/Interval.hs" #-} (forevery genSortedIntervals $ \xs -> let cs = components xs in all (\(i,j) -> i == j || not (i `intersects` j)) [(c1,c2) | c1 <- cs, c2 <- cs])- DocTest.printPrefix "Data.Interval:355: "-{-# LINE 355 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:363: "+{-# LINE 363 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 355 "src/Data/Interval.hs" #-}+{-# LINE 363 "src/Data/Interval.hs" #-} (forevery genSortedIntervals $ \xs -> componentsSeq (Seq.fromList xs) == Seq.fromList (components xs))- DocTest.printPrefix "Data.Interval:356: "-{-# LINE 356 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:364: "+{-# LINE 364 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 356 "src/Data/Interval.hs" #-}+{-# LINE 364 "src/Data/Interval.hs" #-} (forevery genSortedIntervalSeq $ \xs -> let cs = componentsSeq xs in all (\(i,j) -> i == j || not (i `intersects` j)) $ do {c1 <- cs; c2 <- cs; return (c1,c2)})- DocTest.printPrefix "Data.Interval:369: "-{-# LINE 369 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:377: "+{-# LINE 377 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 369 "src/Data/Interval.hs" #-}+{-# LINE 377 "src/Data/Interval.hs" #-} (foreveryPairOf genInterval genIntervalSeq $ \i js -> all (contains i) (covered i js))- DocTest.printPrefix "Data.Interval:370: "-{-# LINE 370 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:378: "+{-# LINE 378 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 370 "src/Data/Interval.hs" #-}+{-# LINE 378 "src/Data/Interval.hs" #-} (foreveryPairOf genInterval genIntervalSeq $ \i js -> covered i (covered i js) == covered i js)- DocTest.printPrefix "Data.Interval:376: "-{-# LINE 376 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:384: "+{-# LINE 384 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 376 "src/Data/Interval.hs" #-}+{-# LINE 384 "src/Data/Interval.hs" #-} (foreveryPair genInterval $ \i j -> j `contains` i == i `coveredBy` [j])- DocTest.printPrefix "Data.Interval:377: "-{-# LINE 377 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:385: "+{-# LINE 385 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 377 "src/Data/Interval.hs" #-}+{-# LINE 385 "src/Data/Interval.hs" #-} (foreveryPairOf genInterval genSortedIntervals $ \i js -> i `coveredBy` js ==> any (flip contains i) (components js))- DocTest.printPrefix "Data.Interval:383: "-{-# LINE 383 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:391: "+{-# LINE 391 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 383 "src/Data/Interval.hs" #-}+{-# LINE 391 "src/Data/Interval.hs" #-} (foreveryPairOf genNonEmptyInterval genIntervalSeq $ \i js -> i `coveredBy` js == (fractionCovered i js >= (1::Rational)))- DocTest.printPrefix "Data.Interval:384: "-{-# LINE 384 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:392: "+{-# LINE 392 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 384 "src/Data/Interval.hs" #-}+{-# LINE 392 "src/Data/Interval.hs" #-} (foreveryPairOf genNonEmptyInterval genNonEmptyIntervalSeq $ \i js -> any (properlyIntersects i) js == (fractionCovered i js > (0::Rational)))- DocTest.printPrefix "Data.Interval:403: "-{-# LINE 403 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:411: "+{-# LINE 411 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 403 "src/Data/Interval.hs" #-}+{-# LINE 411 "src/Data/Interval.hs" #-} (foreveryPair genInterval $ \i j -> i `intersects` j == (overlap i j == EQ))- DocTest.printPrefix "Data.Interval:421: "-{-# LINE 421 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:429: "+{-# LINE 429 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 421 "src/Data/Interval.hs" #-}+{-# LINE 429 "src/Data/Interval.hs" #-} (foreveryPair genInterval $ \i j -> i `properlyIntersects` j == (properOverlap i j == EQ))- DocTest.printPrefix "Data.Interval:433: "-{-# LINE 433 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:441: "+{-# LINE 441 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 433 "src/Data/Interval.hs" #-}+{-# LINE 441 "src/Data/Interval.hs" #-} (foreveryPair genInterval $ \i j -> (lb i <= ub i && lb j <= ub j && i `intersects` j) == (max (lb i) (lb j) <= min (ub i) (ub j)))- DocTest.printPrefix "Data.Interval:430: "-{-# LINE 430 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:438: "+{-# LINE 438 "src/Data/Interval.hs" #-} DocTest.example-{-# LINE 430 "src/Data/Interval.hs" #-}+{-# LINE 438 "src/Data/Interval.hs" #-} (((1,2)::(Int,Int)) `intersects` ((2,3)::(Int,Int))) [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Data.Interval:444: "-{-# LINE 444 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:452: "+{-# LINE 452 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 444 "src/Data/Interval.hs" #-}+{-# LINE 452 "src/Data/Interval.hs" #-} (foreveryPair genInterval $ \i j -> ((i `intersects` j) && not (i `properlyIntersects` j)) == (ub i == lb j || ub j == lb i))- DocTest.printPrefix "Data.Interval:450: "-{-# LINE 450 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:458: "+{-# LINE 458 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 450 "src/Data/Interval.hs" #-}+{-# LINE 458 "src/Data/Interval.hs" #-} (forevery genInterval $ \i -> i `contains` i)- DocTest.printPrefix "Data.Interval:451: "-{-# LINE 451 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:459: "+{-# LINE 459 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 451 "src/Data/Interval.hs" #-}+{-# LINE 459 "src/Data/Interval.hs" #-} (foreveryPair genInterval $ \i j -> (i `contains` j && j `contains` i) == (i==j))- DocTest.printPrefix "Data.Interval:452: "-{-# LINE 452 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:460: "+{-# LINE 460 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 452 "src/Data/Interval.hs" #-}+{-# LINE 460 "src/Data/Interval.hs" #-} (foreveryPair genInterval $ \i j -> i `contains` j == (maybeUnion i j == Just i))- DocTest.printPrefix "Data.Interval:464: "-{-# LINE 464 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:472: "+{-# LINE 472 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 464 "src/Data/Interval.hs" #-}+{-# LINE 472 "src/Data/Interval.hs" #-} (forevery genSortedList $ \xs -> (components $ toList $ fromEndPoints xs) == if length xs < 2 then [] else [(head xs, last xs)])- DocTest.printPrefix "Data.Interval:465: "-{-# LINE 465 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:473: "+{-# LINE 473 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 465 "src/Data/Interval.hs" #-}+{-# LINE 473 "src/Data/Interval.hs" #-} (forevery genSortedList $ \xs -> hullSeqNonNested (fromEndPoints xs) == if length xs < 2 then Nothing else Just (head xs,last xs))- DocTest.printPrefix "Data.Interval:478: "-{-# LINE 478 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:487: "+{-# LINE 487 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 478 "src/Data/Interval.hs" #-}- (foreveryPairOf genInterval genSortedIntervalSeq $ \i js -> toList (getIntersects i (FromSortedSeq js)) `List.isSubsequenceOf` toList js)- DocTest.printPrefix "Data.Interval:479: "-{-# LINE 479 "src/Data/Interval.hs" #-}+{-# LINE 487 "src/Data/Interval.hs" #-}+ (foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js -> toList (getIntersects i (FromSortedSeq js)) `isSubsequenceOf` toList js)+ DocTest.printPrefix "Data.Interval:488: "+{-# LINE 488 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 479 "src/Data/Interval.hs" #-}+{-# LINE 488 "src/Data/Interval.hs" #-} (forevery genSortedIntervalSeq $ \xs -> propSplit (\subseq -> subseq == sortByRight subseq) (splitSeq xs))- DocTest.printPrefix "Data.Interval:496: "-{-# LINE 496 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:505: "+{-# LINE 505 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 496 "src/Data/Interval.hs" #-}+{-# LINE 505 "src/Data/Interval.hs" #-} (forevery genSortedIntervalSeq $ \xs -> hullSeq xs == if Seq.null xs then Nothing else Just (minimum (fmap lb xs),maximum (fmap ub xs)))- DocTest.printPrefix "Data.Interval:497: "-{-# LINE 497 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:506: "+{-# LINE 506 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 497 "src/Data/Interval.hs" #-}+{-# LINE 506 "src/Data/Interval.hs" #-} (forevery genSortedIntervalSeq $ \xs -> hullSeq xs == hull (toList xs))- DocTest.printPrefix "Data.Interval:516: "-{-# LINE 516 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:525: "+{-# LINE 525 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 516 "src/Data/Interval.hs" #-}+{-# LINE 525 "src/Data/Interval.hs" #-} (foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js' -> let js = toList js' in fst (splitIntersecting i js) == filter (intersects i) js)- DocTest.printPrefix "Data.Interval:517: "-{-# LINE 517 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:526: "+{-# LINE 526 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 517 "src/Data/Interval.hs" #-}+{-# LINE 526 "src/Data/Interval.hs" #-} (foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js' -> let js = toList js' in all (\j -> not (ub j < ub i)) (snd (splitIntersecting i js)))- DocTest.printPrefix "Data.Interval:513: "-{-# LINE 513 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:522: "+{-# LINE 522 "src/Data/Interval.hs" #-} DocTest.example-{-# LINE 513 "src/Data/Interval.hs" #-}+{-# LINE 522 "src/Data/Interval.hs" #-} (splitIntersecting ((2,5) :: (Int,Int)) ([(0,1),(2,2),(2,3),(3,6),(6,7)] :: [(Int,Int)])) [ExpectedLine [LineChunk "([(2,2),(2,3),(3,6)],[(3,6),(6,7)])"]]- DocTest.printPrefix "Data.Interval:537: "-{-# LINE 537 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:546: "+{-# LINE 546 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 537 "src/Data/Interval.hs" #-}+{-# LINE 546 "src/Data/Interval.hs" #-} (foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js' -> let js = toList js' in fst (splitProperlyIntersecting i js) == filter (properlyIntersects i) js)- DocTest.printPrefix "Data.Interval:538: "-{-# LINE 538 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:547: "+{-# LINE 547 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 538 "src/Data/Interval.hs" #-}+{-# LINE 547 "src/Data/Interval.hs" #-} (foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js' -> let js = toList js' in all (not.properlyContains i) (snd (splitProperlyIntersecting i js)))- DocTest.printPrefix "Data.Interval:534: "-{-# LINE 534 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:543: "+{-# LINE 543 "src/Data/Interval.hs" #-} DocTest.example-{-# LINE 534 "src/Data/Interval.hs" #-}+{-# LINE 543 "src/Data/Interval.hs" #-} (splitProperlyIntersecting ((2,5) :: (Int,Int)) ([(0,1),(2,3),(2,2),(3,5),(5,6),(6,7)] :: [(Int,Int)])) [ExpectedLine [LineChunk "([(2,3),(3,5)],[(5,6),(6,7)])"]]- DocTest.printPrefix "Data.Interval:570: "-{-# LINE 570 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:579: "+{-# LINE 579 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 570 "src/Data/Interval.hs" #-}+{-# LINE 579 "src/Data/Interval.hs" #-} (forevery genSortedIntervalSeq $ \xs -> hullSeq xs == hullOfTree (itree 4 xs))- DocTest.printPrefix "Data.Interval:581: "-{-# LINE 581 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:590: "+{-# LINE 590 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 581 "src/Data/Interval.hs" #-}+{-# LINE 590 "src/Data/Interval.hs" #-} (forevery genIntervalSeq $ \xs -> invariant . itree 4 $ xs)- DocTest.printPrefix "Data.Interval:591: "-{-# LINE 591 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:600: "+{-# LINE 600 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 591 "src/Data/Interval.hs" #-}+{-# LINE 600 "src/Data/Interval.hs" #-} (foreveryPairOf genInterval genIntervalSeq $ \i t -> on (==) sortByRight (getIntersects i $ itree 2 t) (i `intersecting` t))- DocTest.printPrefix "Data.Interval:602: "-{-# LINE 602 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:611: "+{-# LINE 611 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 602 "src/Data/Interval.hs" #-}+{-# LINE 611 "src/Data/Interval.hs" #-} (foreveryPairOf genInterval genIntervalSeq $ \i t -> on (==) sortByRight (getProperIntersects i $ itree 2 t) (i `intersectingProperly` t))- DocTest.printPrefix "Data.Interval:734: "-{-# LINE 734 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:743: "+{-# LINE 743 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 734 "src/Data/Interval.hs" #-}+{-# LINE 743 "src/Data/Interval.hs" #-} (forevery genIntervalSeq $ \is -> joinSeq (splitSeq is) == is)- DocTest.printPrefix "Data.Interval:796: "-{-# LINE 796 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:805: "+{-# LINE 805 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 796 "src/Data/Interval.hs" #-}+{-# LINE 805 "src/Data/Interval.hs" #-} (forevery genNonNestedIntervalSeq $ \xs -> hullSeqNonNested xs == hullSeq xs)- DocTest.printPrefix "Data.Interval:813: "-{-# LINE 813 "src/Data/Interval.hs" #-}+ DocTest.printPrefix "Data.Interval:822: "+{-# LINE 822 "src/Data/Interval.hs" #-} DocTest.property-{-# LINE 813 "src/Data/Interval.hs" #-}+{-# LINE 822 "src/Data/Interval.hs" #-} (foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js -> getIntersects i (FromSortedSeq js) == intersecting i js)
src/Data/Interval.hs view
@@ -115,6 +115,7 @@ -- >>> import Data.Foldable (toList) -- >>> import Test.QuickCheck ((==>)) -- >>> without' :: (Int,Int) -> (Int,Int) -> [(Int,Int)]; without' = without +-- >>> isSubsequenceOf :: Eq a => [a] -> [a] -> Bool; isSubsequenceOf [] _ = True; isSubsequenceOf (_:_) [] = False; isSubsequenceOf xs@(x:xs') (y:ys) = (x == y && xs' `List.isPrefixOf` ys) || xs `isSubsequenceOf` ys -- | class of intervals with end points in a totally ordered type @@ -177,6 +178,13 @@ -- False -- -- Thus, when querying against a set of intervals with nesting, you must use an 'ITree' instead. +-- Observe that non-nestedness is a quite strong property. +-- The logical negation of the sentence /there exist intervals i, j such that i is contained in j/ +-- is /for all i, j either/ @lb i < lb j@ or @ub i > ub j@. +-- But if @lb i < lb j@ then also @ub i < ub j@ because otherwise i contains j. +-- Likewise, @ub i > ub j@ implies @lb i > lb j@ otherwise i contains j. +-- Hence a non-nested sequence of intervals can be sorted by either left of right end-point +-- resulting in the same order. -- -- prop> forevery genNonNestedIntervalSeq $ \xs -> propSplit (\subseq -> hullSeqNonNested subseq == hullSeq subseq) (splitSeq xs) newtype NonNestedSeq a = FromSortedSeq {getSeq :: Seq a} deriving (Eq,Ord,Show,Functor,Foldable,Traversable) @@ -472,10 +480,11 @@ EmptyL -> error "Intervals.fromEndPoints: this should never happen" -- | lexicographical sort by 'ub', then inverse 'lb'. --- In the resulting list, the intervals intersecting +-- If the sequence of intervals is non-nested, then +-- in the resulting list the intervals intersecting -- a given interval form a contiguous sublist. -- --- prop> foreveryPairOf genInterval genSortedIntervalSeq $ \i js -> toList (getIntersects i (FromSortedSeq js)) `List.isSubsequenceOf` toList js +-- prop> foreveryPairOf genInterval genNonNestedIntervalSeq $ \i js -> toList (getIntersects i (FromSortedSeq js)) `isSubsequenceOf` toList js -- prop> forevery genSortedIntervalSeq $ \xs -> propSplit (\subseq -> subseq == sortByRight subseq) (splitSeq xs) sortByRight :: (Interval e i) => Seq i -> Seq i sortByRight = Seq.sortBy (\i j -> compare (ub i) (ub j) <> compare (lb j) (lb i))
test/Data/IntervalTest.hs view
@@ -19,7 +19,7 @@ import qualified Data.Sequence as Seq import qualified Data.List as List import Data.Foldable (toList)-import Data.Sequence (Seq)+import Data.Sequence (Seq,(|>)) import Data.Time (UTCTime) import Control.Arrow (first)@@ -89,14 +89,22 @@ genIntervalSeq = withShrinkSeq $ fmap Seq.fromList $ QC.listOf $ fst genInterval --- | generate a Sequence of non-nested intervals by means of 'fromEndPoints'+-- | For @i :: Intv@ generates @j@ such that +-- @lb i < lb j@ and @ub i < ub j@ +genNextIntv :: Intv -> QC.Gen Intv+genNextIntv i = do+ x <- genUTCTime `QC.suchThat` ((lb i)<)+ y <- genUTCTime `QC.suchThat` ((max x (ub i))<)+ return (x,y)++-- | generate a Sequence of non-nested intervals genNonNestedIntervalSeq :: Gen (Seq Intv)-genNonNestedIntervalSeq =- withShrinkSeq $- filterM (const QC.arbitrary) . fromEndPoints . List.sort- =<< QC.listOf genUTCTime--- TODO: these are also non-properly-overlapping, but we wish to include --- non-containment overlaps in the tests.+genNonNestedIntervalSeq = withShrinkSeq $ fst genInterval >>= go mempty where+ go js j = do+ done <- QC.arbitrary+ if done then return js else do+ i <- genNextIntv j+ go (js |> j) i genNonEmptyIntervalSeq :: Gen (Seq Intv) genNonEmptyIntervalSeq =