interval-patterns 0.5.0.0 → 0.6.0.0

raw patch · 8 files changed

+71/−32 lines, 8 filesdep −relude

Dependencies removed: relude

Files

• CHANGELOG.md +9/−0
• interval-patterns.cabal +3/−8
• src/Data/Calendar.hs +15/−3
• src/Data/Interval.hs +8/−1
• src/Data/Interval/Borel.hs +9/−7
• src/Data/Interval/Layers.hs +22/−12
• src/Data/OneOrTwo.hs +2/−1
• src/Data/Timeframe.hs +3/−0

@@ -1,5 +1,14 @@ # Revision history for interval-patterns +## 0.6.0.0 - 2022-12-04++* drop `relude` dependency+* preemptively import `type (~)` where necessary++## 0.5.1.0 - 2022-08-04++* improve performance of `Layers.fromList`+ ## 0.5.0.0 - 2022-08-04  * fix direction of `diffUTCTime` in `erlangs`

@@ -1,7 +1,7 @@ cabal-version: 3.0 name: interval-patterns-version: 0.5.0.0-author: Melanie Brown+version: 0.6.0.0+author: Melanie Phoenix synopsis: Intervals, and monoids thereof description: Please see the README at https://github.com/mixphix/interval-patterns category: Algebra, Charts, Data Structures, Math, Statistics@@ -11,7 +11,7 @@ homepage: https://github.com/mixphix/interval-patterns bug-reports: https://github.com/mixphix/interval-patterns/issues extra-source-files: CHANGELOG.md-copyright: 2022 Melanie Brown+copyright: 2022 Melanie Phoenix  common interval-patterns   build-depends:@@ -20,7 +20,6 @@     , groups >= 0.2.2     , lattices >= 2.0.3 && < 2.1     , semirings >= 0.6 && < 0.7-    , relude >= 1.0.0.1 && < 1.1     , time     , time-compat >= 1.9.6.1 && < 1.10   default-extensions:@@ -61,10 +60,6 @@     ViewPatterns   default-language: Haskell2010   ghc-options: -Wall -Wcompat -Wno-unticked-promoted-constructors-  mixins:-    base hiding (Prelude)-    , relude (Relude as Prelude)-    , relude  library   import: interval-patterns

@@ -16,9 +16,15 @@   totalDuration, ) where +import Control.Applicative (liftA2)+import Data.Data (Typeable)+import Data.Foldable (fold)+import Data.Maybe (fromMaybe)+import Data.Monoid (Sum (Sum, getSum)) import Data.Interval qualified as I import Data.Interval.Layers (Layers) import Data.Interval.Layers qualified as Layers+import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Time.Compat import Data.Timeframe@@ -45,7 +51,10 @@ -- all of the simultaneous happenings over a given span (on average)? erlangs :: (Real n) => Timeframe -> Event n -> Maybe Rational erlangs ix e =-  let diff = realToFrac <<$>> flip diffUTCTime+  let+    infixr 9 <<$>>+    (<<$>>) = fmap . fmap+    diff = realToFrac <<$>> flip diffUTCTime    in liftA2         (/)         (Layers.integrate diff (realToFrac . getSum) ix e)@@ -87,10 +96,13 @@ -- Get the 'Event' corresponding to a given key, -- or 'mempty' if the key is not present. (!) :: (Ord ev, Num n) => Calendar ev n -> ev -> Event n-Calendar c ! ev = c Map.!? ev ?: mempty+Calendar c ! ev = fromMaybe mempty (c Map.!? ev)  toList :: (Ord ev, Num n) => Calendar ev n -> [(ev, [(Interval UTCTime, n)])]-toList (Calendar c) = fmap getSum <<$>> Layers.toList <<$>> Map.assocs c+toList (Calendar c) = fmap (fmap getSum) <<$>> Layers.toList <<$>> Map.assocs c+ where+  infixr 9 <<$>>+  (<<$>>) = fmap . fmap  -- | -- What, and how many events are happening

@@ -75,10 +75,17 @@ ) where  import Algebra.Lattice.Levitated+import Control.Applicative (Const (Const), liftA2)+import Control.Monad (join) import Data.Data+import Data.Function (on)+import Data.Kind (Type, Constraint)+import Data.List (sort)+import Data.List.NonEmpty (NonEmpty ((:|))) import Data.OneOrTwo (OneOrTwo (..))+import Data.Ord (comparing)+import Data.Type.Equality (type (~)) import GHC.Generics hiding (Infix)-import GHC.Show qualified (show)  -- | The kinds of extremum an interval can have. data Extremum

@@ -26,13 +26,19 @@  import Algebra.Heyting (Heyting ((==>))) import Algebra.Lattice-import Data.Data+import Control.Arrow ((>>>))+import Data.Data (Data, Typeable)+import Data.Foldable (fold)+import Data.Functor ((<&>)) import Data.Interval (Interval) import Data.Interval qualified as I+import Data.List.NonEmpty (NonEmpty ((:|))) import Data.OneOrTwo (OneOrTwo (..)) import Data.Semiring (Ring, Semiring) import Data.Semiring qualified as Semiring+import Data.Set (Set) import Data.Set qualified as Set+import GHC.Generics (Generic) import Prelude hiding (null, truncate)  -- | The 'Borel' sets on a type are the sets generated by its intervals.@@ -49,10 +55,6 @@ newtype Borel x = Borel (Set (Interval x))   deriving (Eq, Ord, Show, Generic, Typeable, Data) -instance (Ord x) => One (Borel x) where-  type OneItem _ = Interval x-  one = singleton- instance (Ord x) => Semigroup (Borel x) where   Borel is <> Borel js = Borel (unionsSet (is <> js)) @@ -110,7 +112,7 @@  -- | The maximal 'Borel' set, that covers the entire range. whole :: (Ord x) => Borel x-whole = Borel (Prelude.one I.Whole)+whole = Borel (Set.singleton I.Whole)  -- | -- Completely remove an 'Interval' from a 'Borel' set.@@ -159,7 +161,7 @@ -- so that its 'hull' is contained in @i@. truncate :: (Ord x) => Interval x -> Borel x -> Borel x truncate i (Borel js) =-  foldr ((<>) . maybe mempty one . I.intersect i) mempty js+  foldr ((<>) . maybe mempty singleton . I.intersect i) mempty js  -- | Flipped infix version of 'truncate'. (\=) :: (Ord x) => Borel x -> Interval x -> Borel x

@@ -24,14 +24,24 @@ ) where  import Algebra.Lattice.Levitated-import Data.Data+import Data.Data (Data, Typeable) import Data.Group (Group (..))-import Data.Interval (Adjacency (..), Interval, OneOrTwo (..), pattern Whole, pattern (:---:), pattern (:<>:))+import Data.List (sortOn)+import Data.Interval (+  Adjacency (..),+  Interval,+  OneOrTwo (..),+  pattern Whole,+  pattern (:---:),+  pattern (:<>:)+ ) import Data.Interval qualified as I import Data.Interval.Borel (Borel) import Data.Interval.Borel qualified as Borel+import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map-import Prelude hiding (empty, fromList, truncate)+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@.@@ -59,7 +69,7 @@  -- | Draw the 'Layers' of specified bases and thicknesses. fromList :: (Ord x, Semigroup y) => [(Interval x, y)] -> Layers x y-fromList = foldMap (uncurry singleton)+fromList = Layers . Map.fromList . nestings  -- | Get all of the bases and thicknesses in the 'Layers'. toList :: (Ord x) => Layers x y -> [(Interval x, y)]@@ -209,14 +219,14 @@         (j, jy) : js     During i j k ->       nestings $-        (i, iy) :+        (i, jy) :         (j, iy <> jy) :         (k, jy) : js     Finishes i j ->       nestings $         (i, iy) :         (j, iy <> jy) : js-    Identical i -> (i, iy <> jy) : nestings js+    Identical i -> nestings ((i, iy <> jy) : js)     FinishedBy i j ->       nestings $         (i, iy) :@@ -225,16 +235,16 @@       nestings $         (i, iy) :         (j, iy <> jy) :-        (k, jy) : js+        (k, iy) : js     StartedBy i j ->       nestings $         (i, iy <> jy) :-        (j, jy) : js+        (j, iy) : js     OverlappedBy i j k ->       nestings $-        (i, iy) :+        (i, jy) :         (j, iy <> jy) :-        (k, jy) : js-    MetBy i j k -> (i, iy) : nestings ((j, iy <> jy) : (k, jy) : js)-    After i j -> (i, iy) : nestings ((j, jy) : js)+        (k, iy) : js+    MetBy i j k -> (i, jy) : nestings ((j, iy <> jy) : (k, iy) : js)+    After i j -> (i, jy) : nestings ((j, iy) : js)   x -> x

@@ -3,7 +3,8 @@   oneOrTwo, ) where -import Data.Data (Data)+import Data.Data (Data, Typeable)+import GHC.Generics (Generic)  -- | Either one of something, or two of it. --

@@ -7,6 +7,9 @@   duration, ) where +import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Function (on)+import Data.Functor ((<&>)) import Data.Interval import Data.Time.Compat import GHC.IO (unsafePerformIO)