interval-patterns 0.8.0 → 0.8.1

raw patch · 9 files changed

+99/−34 lines, 9 filesdep +indexed-traversabledep ~containersdep ~hashabledep ~semiringsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: indexed-traversable

Dependency ranges changed: containers, hashable, semirings, time

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• LICENSE +1/−1
• interval-patterns.cabal +15/−14
• src/Data/Calendar.hs +1/−2
• src/Data/Interval.hs +12/−8
• src/Data/Interval/Borel.hs +10/−5
• src/Data/Interval/Layers.hs +22/−2
• src/Data/OneOrTwo.hs +1/−2
• tests/Main.hs +28/−0

@@ -1,5 +1,14 @@ # Revision history for interval-patterns +##++## 0.8.1++* `unBorel :: (Ord x) => Borel x -> [Interval x]`, the ordered list of intervals in the `Borel` set+* remove explicit `Typeable` deriving+* add `(Functor|Foldable|Traversable)WithIndex` classes to `Layers`+* `Layers.squashing` and `Layers.isquashing`+ ## 0.8.0  * `newtype Shrink x = Shrink {getShrink :: Borel x}`, the monoid formed by `Borel.intersection` and `whole`

@@ -1,4 +1,4 @@-Copyright 2022 Melanie Brown+Copyright 2022-2025 Melanie Phoenix Brown  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 

@@ -1,31 +1,32 @@ cabal-version:      3.0 name:               interval-patterns-version:            0.8.0-author:             Melanie Brown+version:            0.8.1+author:             Melanie Phoenix Brown synopsis:           Intervals, and monoids thereof category:           Algebra, Charts, Data Structures, Math, Statistics-maintainer:         brown.m@pm.me+maintainer:         brown.m@proton.me license:            BSD-3-Clause license-file:       LICENSE homepage:           https://github.com/mixphix/interval-patterns bug-reports:        https://github.com/mixphix/interval-patterns/issues extra-source-files: CHANGELOG.md-copyright:          2023-2024 Melanie Brown+copyright:          2022-2025 Melanie Phoenix Brown description:   Please see the README at https://github.com/mixphix/interval-patterns  common interval-patterns   build-depends:-    , base         >=4.11    && <5-    , containers   >=0.6.7   && <0.8-    , deepseq      >=1.4.8   && <1.6-    , groups       >=0.5.3   && <0.6-    , hashable     >=1.4.2   && <1.5-    , heaps        >=0.4     && <0.5-    , lattices     >=2.1     && <3-    , semirings    >=0.6     && <0.7-    , time         >=1.9.3   && <1.13-    , time-compat  >=1.9.6.1 && <1.10+    , base                >=4.11    && <5+    , containers          >=0.6.7   && <0.9+    , deepseq             >=1.4.8   && <1.6+    , groups              >=0.5.3   && <0.6+    , hashable            >=1.4.2   && <1.6+    , heaps               >=0.4     && <0.5+    , indexed-traversable >=0.1.4   && <0.2+    , lattices            >=2.1     && <3+    , semirings           >=0.6     && <0.8+    , time                >=1.9.3   && <1.15+    , time-compat         >=1.9.6.1 && <1.10    default-language:   GHC2021   default-extensions:

@@ -17,7 +17,6 @@ ) where  import Algebra.Lattice.Levitated (Levitated (..))-import Data.Data (Typeable) import Data.Foldable (fold) import Data.Interval qualified as I import Data.Interval.Layers (Layers)@@ -59,7 +58,7 @@  -- | A 'Calendar' is a map from a given event type to durations. newtype Calendar ev n = Calendar {getCalendar :: Map ev (Event n)}-  deriving (Eq, Ord, Show, Typeable)+  deriving (Eq, Ord, Show)  instance (Ord ev, Ord n, Num n) => Semigroup (Calendar ev n) where   (<>) ::

@@ -118,7 +118,7 @@   | Infimum   | Supremum   | Maximum-  deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Data, Typeable)+  deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Data)  -- | -- The 'opposite' of an 'Extremum' is its complementary analogue:@@ -552,8 +552,6 @@     , intervalClosedClosedConstr     ] -deriving instance (Typeable x) => Typeable (Interval x)- instance (Ord x, Generic x) => Generic (Interval x) where   type     Rep (Interval x) =@@ -561,10 +559,10 @@    from :: (Ord x, Generic x) => Interval x -> Rep (Interval x) x1   from = \case-    l :<->: u -> (Const (l, Infimum) :*: Const (u, Supremum))-    l :|->: u -> (Const (l, Minimum) :*: Const (u, Supremum))-    l :<-|: u -> (Const (l, Infimum) :*: Const (u, Maximum))-    l :|-|: u -> (Const (l, Minimum) :*: Const (u, Maximum))+    l :<->: u -> Const (l, Infimum) :*: Const (u, Supremum)+    l :|->: u -> Const (l, Minimum) :*: Const (u, Supremum)+    l :<-|: u -> Const (l, Infimum) :*: Const (u, Maximum)+    l :|-|: u -> Const (l, Minimum) :*: Const (u, Maximum)    to :: (Ord x, Generic x) => Rep (Interval x) x1 -> Interval x   to (Const l :*: Const u) = l ... u@@ -721,7 +719,7 @@   | OverlappedBy !(Interval x) !(Interval x) !(Interval x)   | MetBy !(Interval x) !(Interval x) !(Interval x)   | After !(Interval x) !(Interval x)-  deriving (Eq, Ord, Show, Generic, Typeable, Data)+  deriving (Eq, Ord, Show, Generic, Data)  -- | The result of having compared the same two intervals in reverse order. converseAdjacency :: Adjacency x -> Adjacency x@@ -927,6 +925,8 @@   l :|->: _ -> l :|->: x   l :|-|: _ -> l :|-|: x +infixl 4 `intersect`+ -- | Calculate the intersection of two intervals, if it exists. -- -- @@@ -960,6 +960,8 @@   MetBy _ j _ -> Just j   After _ _ -> Nothing +infixl 4 `union`+ -- | Get the union of two intervals, as either 'OneOrTwo'. -- -- @@@ -1044,6 +1046,8 @@   l :|->: u -> Just (Two (Bottom :|->: l) (u :|-|: Top))   l :<-|: u -> Just (Two (Bottom :|-|: l) (u :<-|: Top))   l :<->: u -> Just (Two (Bottom :|-|: l) (u :|-|: Top))++infix 4 `difference`  -- | Remove all points of the second interval from the first. --

@@ -1,6 +1,7 @@ module Data.Interval.Borel (-  Borel (Borel),+  Borel,   borel,+  unBorel,   intervalSet,   Data.Interval.Borel.empty,   singleton,@@ -32,7 +33,7 @@   Lattice (..),  ) import Algebra.Lattice.Levitated (Levitated (..))-import Data.Data (Data, Typeable)+import Data.Data (Data) import Data.Foldable (fold) import Data.Functor ((<&>)) import Data.Interval (Interval)@@ -58,7 +59,7 @@ -- how many times each given point has been covered. -- To keep track of this data, use 'Data.Interval.Layers.Layers'. newtype Borel x = Borel (Set (Interval x))-  deriving (Eq, Ord, Show, Generic, Typeable, Data)+  deriving (Eq, Ord, Show, Generic, Data)  instance (Ord x) => Semigroup (Borel x) where   (<>) :: (Ord x) => Borel x -> Borel x -> Borel x@@ -106,12 +107,16 @@  -- | Consider the 'Borel' set identified by a list of 'Interval's. borel :: (Ord x) => [Interval x] -> Borel x-borel = Borel . Set.fromList . I.unions+borel = Borel . Set.fromAscList . I.unions  -- | Turn a 'Borel' set into a 'Set.Set' of 'Interval's. intervalSet :: (Ord x) => Borel x -> Set (Interval x) intervalSet (Borel is) = unionsSet is +-- | Get the ordered list of 'Interval's from a 'Borel' set.+unBorel :: (Ord x) => Borel x -> [Interval x]+unBorel = Set.toAscList . intervalSet+ unionsSet :: (Ord x) => Set (Interval x) -> Set (Interval x) unionsSet = Set.fromAscList . I.unionsAsc . Set.toAscList @@ -204,7 +209,7 @@  -- | Newtype wrapper for the monoid under 'intersection'. newtype Shrink x = Shrink {getShrink :: Borel x}-  deriving (Eq, Ord, Show, Generic, Typeable, Data)+  deriving (Eq, Ord, Show, Generic, Data)  instance (Ord x) => Semigroup (Shrink x) where   (<>) :: (Ord x) => Shrink x -> Shrink x -> Shrink x

@@ -7,6 +7,8 @@   insert,   pile,   squash,+  squashing,+  isquashing,   land,   landAbove,   thickness,@@ -26,8 +28,10 @@ ) where  import Algebra.Lattice.Levitated (Levitated (Top))-import Data.Data (Data, Typeable)+import Data.Data (Data) import Data.Foldable qualified as Foldable+import Data.Foldable.WithIndex (FoldableWithIndex, ifoldMap)+import Data.Functor.WithIndex import Data.Group (Group (..)) import Data.Heap (Heap) import Data.Heap qualified as Heap@@ -44,13 +48,21 @@ import Data.Interval.Borel qualified as Borel import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map+import Data.Traversable.WithIndex (TraversableWithIndex (itraverse)) import GHC.Generics (Generic) import Prelude hiding (truncate)  -- The 'Layers' of an ordered type @x@ are like the 'Borel' sets, -- but that keeps track of how far each point has been "raised" in @y@. newtype Layers x y = Layers (Map (Interval x) y)-  deriving (Eq, Ord, Show, Functor, Generic, Typeable, Data)+  deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Generic, Data)+deriving newtype instance FunctorWithIndex (Interval x) (Layers x)+deriving newtype instance FoldableWithIndex (Interval x) (Layers x)+instance TraversableWithIndex (Interval x) (Layers x) where+  itraverse ::+    (Applicative f) =>+    (Interval x -> a -> f b) -> Layers x a -> f (Layers x b)+  itraverse f (Layers s) = Layers <$> itraverse f s  instance (Ord x, Ord y, Semigroup y) => Semigroup (Layers x y) where   (<>) :: (Ord x, Ord y, Semigroup y) => Layers x y -> Layers x y -> Layers x y@@ -89,6 +101,14 @@ -- any contained 'Interval' or not. squash :: (Ord x) => Layers x y -> Borel x squash (Layers s) = foldMap Borel.singleton (Map.keys s)++-- | 'squash' together the intervals satisfying a predicate.+squashing :: (Ord x) => (y -> Bool) -> Layers x y -> Borel x+squashing = isquashing . const++-- | Perform 'squashing' with a test that accepts the 'Interval' as an argument.+isquashing :: (Ord x) => (Interval x -> y -> Bool) -> Layers x y -> Borel x+isquashing f s = flip ifoldMap s \ix y -> if f ix y then Borel.singleton ix else Borel.empty  -- | Treating 'mempty' as sea level, consider the 'Borel' set of a provided -- 'Layers' that is "land".

@@ -3,7 +3,7 @@   oneOrTwo, ) where -import Data.Data (Data, Typeable)+import Data.Data (Data) import GHC.Generics (Generic)  -- | Either one of something, or two of it.@@ -19,7 +19,6 @@     , Read     , Generic     , Data-    , Typeable     , Functor     , Foldable     , Traversable

@@ -1,4 +1,5 @@ {-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}  module Main where @@ -21,6 +22,7 @@ import Data.Interval.Borel (Borel) import Data.Interval.Borel qualified as Borel import Data.Interval.Layers qualified as Layers+import Data.List qualified as List import Data.Semigroup import GHC.TypeNats import Test.Hspec@@ -64,6 +66,32 @@         (Levitate x :|->: Levitate x) `shouldBe` (Levitate x :|-|: Levitate x)         (Levitate x :<-|: Levitate x) `shouldBe` (Levitate x :|-|: Levitate x)         (Levitate x :|-|: Levitate x) `shouldBe` (Levitate x :|-|: Levitate x)++    it "intersect" do+      property @(Ints 4 _) \a b c d -> do+        let [x, y, z, w] = List.sort [a, b, c, d]+        when (x /= y && y /= z && z /= w) do+          (x :<>: z `Interval.intersect` y :<>: w) `shouldBe` Just (z :<>: y)+          (x :<|: z `Interval.intersect` y :|>: w) `shouldBe` Just (z :||: y)+          (x :|>: z `Interval.intersect` y :<|: w) `shouldBe` Just (z :<>: y)+          (x :||: z `Interval.intersect` y :||: w) `shouldBe` Just (z :||: y)+    it "union" do+      property @(Ints 4 _) \a b c d -> do+        let [x, y, z, w] = List.sort [a, b, c, d]+        when (x /= y && y /= z && z /= w) do+          (x :<>: z `Interval.union` y :<>: w) `shouldBe` Interval.One (x :<>: w)+          (x :<|: z `Interval.union` y :|>: w) `shouldBe` Interval.One (x :<>: w)+          (x :|>: z `Interval.union` y :<|: w) `shouldBe` Interval.One (x :||: w)+          (x :||: z `Interval.union` y :||: w) `shouldBe` Interval.One (x :||: w)+          when (y < z) do+            (x :<>: y `Interval.union` z :<>: w) `shouldBe` Interval.Two (x :<>: y) (z :<>: w)+            (x :<|: y `Interval.union` z :|>: w) `shouldBe` Interval.Two (x :<|: y) (z :|>: w)+            (x :|>: y `Interval.union` z :<|: w) `shouldBe` Interval.Two (x :|>: y) (z :<|: w)+            (x :||: y `Interval.union` z :||: w) `shouldBe` Interval.Two (x :||: y) (z :||: w)+    it "unions" do+      property @(Ints 8 _) \a b c d e f g h -> do+        let [z, y, x, w, v, u, t, s] = List.sort [a, b, c, d, e, f, g, h]+        Interval.unions [z :||: v, y :||: u, x :||: t, w :||: s] `shouldBe` [z :||: s]    describe "Borel intervals" do     it "(<>) is commutative" do