packages feed

closed-intervals 0.1.0.0 → 0.1.0.1

raw patch · 4 files changed

+23/−5 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

ChangeLog.md view
@@ -1,3 +1,7 @@ # Changelog for closed-intervals +- 0.1.0.1 bugfix in hullSeqNonOverlap which was not caught +  because the QuickCheck generator generated data which +  did not meet the assumptions made by hullSeqNonOverlap.+ ## Unreleased changes
closed-intervals.cabal view
@@ -1,7 +1,7 @@ cabal-version: 1.12  name:           closed-intervals-version:        0.1.0.0+version:        0.1.0.1 synopsis:       Closed intervals of totally ordered types description:    see README.md author:         Olaf Klinke, Henning Thielemann
src/Data/Interval.hs view
@@ -573,7 +573,7 @@ joinSeq (SingletonSeq a) = pure a
 joinSeq (TwoSeqs xs ys) = xs <> ys
 
--- |
+-- | Split a Sequence in half, needed for the IntersectionQuery instances.  
 -- prop> genIntervalSeq /\ \is -> joinSeq (splitSeq is) == is
 splitSeq :: Seq a -> SplitSeq a
 splitSeq xs = let (l,r) = Seq.splitAt (length xs `div` 2) xs in case (null l,null r) of
@@ -629,15 +629,28 @@ 
 -- * Non-overlapping intervals
 
--- | /O(1)/ bounds of an ordered sequence of intervals. 'Nothing', if empty.
+-- | /O(log n)/ bounds of an ordered sequence of intervals. 'Nothing', if empty.
 --
 -- prop> genDisjointIntervalSeq /\ \xs -> hullSeqNonOverlap xs == hullSeq xs
 hullSeqNonOverlap :: Interval e i => Seq i -> Maybe (e,e)
 hullSeqNonOverlap xs = case Seq.viewl xs of
     EmptyL -> Nothing
     leftmost :< others -> Just (lb leftmost, case Seq.viewr others of
-        _ :> rightmost -> ub rightmost
+        _ :> rightmost -> maybe (ub rightmost) ub (findLeftmost ((lb rightmost ==).lb) xs)
         EmptyR         -> ub leftmost)
+-- TODO: This fails e.g. for 
+-- [(0,2),(0,0)] 
+-- for the upper bound need to perform binary search 
+-- for the left-most interval i with lb i == lb rightmost
+
+findLeftmost :: (i -> Bool) -> Seq i -> Maybe i
+findLeftmost p = go where 
+    go xs = case splitSeq xs of
+        EmptySeq           -> Nothing
+        SingletonSeq i     -> if p i then Just i else Nothing
+        TwoSeqs left right -> case go left of
+            foundLeftmost@(Just _) -> foundLeftmost
+            Nothing -> go right
 
 -- | Query an ordered 'Seq'uence of non-overlapping intervals
 -- for a predicate @p@ that has the property
test/Data/IntervalTest.hs view
@@ -84,10 +84,11 @@ genIntervalSeq =     withShrinkSeq $ fmap Seq.fromList $ QC.listOf $ fst genInterval +-- | generate a Sequence of intervals sorted by 'sortByLeft' genDisjointIntervalSeq :: Gen (Seq Intv) genDisjointIntervalSeq =     withShrinkSeq $-    filterM (const QC.arbitrary) . fromEndPoints . List.sort+    filterM (const QC.arbitrary) . sortByLeft . fromEndPoints . List.sort         =<< QC.listOf genUTCTime  genNonEmptyIntervalSeq :: Gen (Seq Intv)