packages feed

numhask-space 0.4.0 → 0.5.0

raw patch · 9 files changed

+103/−92 lines, 9 filesdep ~doctestdep ~protolude

Dependency ranges changed: doctest, protolude

Files

numhask-space.cabal view
@@ -1,6 +1,6 @@-cabal-version: 3.0+cabal-version: 2.4 name: numhask-space-version: 0.4.0+version: 0.5.0 synopsis:   numerical spaces description:@@ -44,17 +44,17 @@     OverloadedStrings     UnicodeSyntax   build-depends:-      base >=4.7 && <5-    , adjunctions >=4.0 && <5-    , semigroupoids >=5 && <6-    , distributive >=0.2.2 && <1-    , lattices >= 2.0.1 && <2.1-    , time >= 1.8.0.2 && <2-    , text >= 1.2.3.1 && <2-    , foldl >= 1.4.5 && <2-    , containers >= 0.6 && < 0.7-    , tdigest >= 0.2.1 && < 0.3-    , protolude >= 0.3.0 && < 0.4.0+    adjunctions >=4.0 && <5,+    base >=4.7 && <5,+    containers >= 0.6 && < 0.7,+    distributive >=0.2.2 && <1,+    foldl >= 1.4.5 && <2,+    lattices >= 2.0.1 && <2.1,+    protolude >= 0.3.0 && < 0.4.0,+    semigroupoids >=5 && <6,+    tdigest >= 0.2.1 && < 0.3,+    text >= 1.2.3.1 && <2,+    time >= 1.8.0.2 && <2   exposed-modules:     NumHask.Space     NumHask.Space.Types@@ -70,10 +70,20 @@   type: exitcode-stdio-1.0   main-is: test.hs   hs-source-dirs:-      test-  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+    test   build-depends:-      base >=4.7 && <5-    , doctest+    base >=4.7 && <5,+    doctest >= 0.16 && < 0.18,+    protolude >= 0.3   default-language: Haskell2010-+  ghc-options:+    -Wall+    -Wcompat+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wredundant-constraints+  default-extensions:+    NegativeLiterals+    NoImplicitPrelude+    OverloadedStrings+    UnicodeSyntax
src/NumHask/Space.hs view
@@ -5,7 +5,6 @@ -- Mathematics does not define a space, leaving library devs to experiment. -- -- https://en.wikipedia.org/wiki/Space_(mathematics)--- module NumHask.Space   ( -- * Space     -- $space@@ -21,11 +20,11 @@   ) where +import NumHask.Space.Histogram hiding () import NumHask.Space.Point hiding () import NumHask.Space.Range hiding () import NumHask.Space.Rect hiding () import NumHask.Space.Time hiding ()-import NumHask.Space.Histogram hiding () import NumHask.Space.Types hiding ()  -- $space
src/NumHask/Space/Histogram.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -Wall #-}  -- | A histogram, if you squint, is a series of contiguous ranges, annotated with values.@@ -17,16 +18,13 @@ where  import qualified Control.Foldl as L-import Data.Bool-import Data.Foldable-import qualified Data.List+import qualified Data.List as List import qualified Data.Map as Map-import Data.Maybe import Data.TDigest import NumHask.Space.Range import NumHask.Space.Rect import NumHask.Space.Types-import Prelude+import Protolude  -- | This Histogram is a list of contiguous boundaries (a boundary being the lower edge of one bucket and the upper edge of another), and a value (usually a count) for each bucket, represented here as a map --@@ -53,7 +51,7 @@ cutI bs n = go bs 0   where     go [] i = i-    go (x:xs) i = bool i (go xs (i+1)) (n>x)+    go (x : xs) i = bool i (go xs (i + 1)) (n > x)  -- | Make a histogram using n equally spaced cuts over the entire range of the data --@@ -69,7 +67,7 @@ -- >>> makeRects IgnoreOvers (regular 4 [0..100]) -- [Rect 0.0 25.0 0.0 0.25,Rect 25.0 50.0 0.0 0.25,Rect 50.0 75.0 0.0 0.25,Rect 75.0 100.0 0.0 0.25] makeRects :: DealOvers -> Histogram -> [Rect Double]-makeRects o (Histogram cs counts) = Data.List.zipWith4 Rect x z y w'+makeRects o (Histogram cs counts) = List.zipWith4 Rect x z y w'   where     y = repeat 0     w =@@ -87,9 +85,9 @@     x = case o of       IgnoreOvers -> cs       IncludeOvers outw ->-        [Data.List.head cs - outw]+        [List.head cs - outw]           <> cs-          <> [Data.List.last cs + outw]+          <> [List.last cs + outw]     z = drop 1 x  -- | approx regular n-quantiles
src/NumHask/Space/Point.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wall #-} @@ -14,14 +15,13 @@ import Data.Distributive as D import Data.Functor.Classes import Data.Functor.Rep-import GHC.Generics (Generic)+import GHC.Show (show) import NumHask.Space.Range import NumHask.Space.Types-import Text.Show-import Prelude+import Protolude as P hiding (rotate)  -- $setup--- +-- >>> :set -XNoImplicitPrelude  -- | A 2-dim point of a's --@@ -44,7 +44,7 @@   deriving (Eq, Generic)  instance (Show a) => Show (Point a) where-  show (Point a b) = "Point " <> Text.Show.show a <> " " <> Text.Show.show b+  show (Point a b) = "Point " <> P.show a <> " " <> P.show b  instance Functor Point where   fmap f (Point a b) = Point (f a) (f b)@@ -56,7 +56,6 @@   liftShowsPrec sp _ d (Point a b) = showsBinaryWith sp sp "Point" d a b  instance Applicative Point where-   pure a = Point a a    (Point fa fb) <*> Point a b = Point (fa a) (fb b)@@ -77,19 +76,16 @@   (Point a0 b0) <> (Point a1 b1) = Point (a0 <> a1) (b0 <> b1)  instance (Semigroup a, Monoid a) => Monoid (Point a) where-   mempty = Point mempty mempty    mappend = (<>)  instance (Bounded a) => Bounded (Point a) where-   minBound = Point minBound minBound    maxBound = Point maxBound maxBound  instance (Num a) => Num (Point a) where-   (Point a0 b0) + (Point a1 b1) = Point (a0 + a1) (b0 + b1)    negate = fmap negate@@ -103,8 +99,7 @@   fromInteger x = Point (fromInteger x) (fromInteger x)  instance (Fractional a) => Fractional (Point a) where--  fromRational x = Point (fromRational x) (fromRational x) +  fromRational x = Point (fromRational x) (fromRational x)    recip = fmap recip @@ -115,7 +110,6 @@       getR (Point _ r) = r  instance Representable Point where-   type Rep Point = Bool    tabulate f = Point (f False) (f True)@@ -124,7 +118,6 @@   index (Point _ r) True = r  instance (Ord a) => Lattice (Point a) where-   (\/) (Point x y) (Point x' y') = Point (max x x') (max y y')    (/\) (Point x y) (Point x' y') = Point (min x x') (min y y')
src/NumHask/Space/Range.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wall #-} @@ -10,16 +11,16 @@ where  import Algebra.Lattice-import Data.Bool (bool)+import Control.Category (id) import Data.Distributive as D import Data.Functor.Apply (Apply (..)) import Data.Functor.Classes import Data.Functor.Rep import Data.Semigroup.Foldable (Foldable1 (..)) import Data.Semigroup.Traversable (Traversable1 (..))-import GHC.Generics (Generic)+import GHC.Show (show) import NumHask.Space.Types as S-import Prelude+import Protolude as P  -- $setup @@ -57,7 +58,7 @@   deriving (Eq, Generic)  instance (Show a) => Show (Range a) where-  show (Range a b) = "Range " <> show a <> " " <> show b+  show (Range a b) = "Range " <> P.show a <> " " <> P.show b  instance Eq1 Range where   liftEq f (Range a b) (Range c d) = f a c && f b d@@ -72,7 +73,6 @@   Range fa fb <.> Range a b = Range (fa a) (fb b)  instance Applicative Range where-   pure a = Range a a    (Range fa fb) <*> Range a b = Range (fa a) (fb b)@@ -95,7 +95,6 @@       getR (Range _ r) = r  instance Representable Range where-   type Rep Range = Bool    tabulate f = Range (f False) (f True)@@ -104,13 +103,11 @@   index (Range _ r) True = r  instance (Ord a) => Lattice (Range a) where-   (\/) = liftR2 min    (/\) = liftR2 max  instance (Eq a, Ord a) => Space (Range a) where-   type Element (Range a) = a    lower (Range l _) = l@@ -120,7 +117,6 @@   (>.<) = Range  instance (Ord a, Fractional a) => FieldSpace (Range a) where-   type Grid (Range a) = Int    grid o s n = (+ bool 0 (step / 2) (o == MidPos)) <$> posns@@ -144,7 +140,6 @@  -- | Numeric algebra based on Interval arithmetic instance (Num a, Eq a, Ord a) => Num (Range a) where-   (Range l u) + (Range l' u') = space1 [l + l', u + u']    negate (Range l u) = negate u ... negate l@@ -170,7 +165,7 @@       | err <= 0.75 = 2.0 * step'       | otherwise = step' --- | a grid with human sensible (rounded) values+-- | a grid for five-digits per limb species -- -- >>> gridSensible OuterPos False (Range (-12.0) 23.0) 6 -- [-15.0,-10.0,-5.0,0.0,5.0,10.0,15.0,20.0,25.0]
src/NumHask/Space/Rect.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wall #-}@@ -29,18 +30,16 @@ where  import Algebra.Lattice-import Data.Bool (bool) import Data.Distributive as D import Data.Functor.Compose import Data.Functor.Rep import Data.List.NonEmpty-import Data.Semigroup import GHC.Exts-import GHC.Generics (Generic)+import GHC.Show (show) import NumHask.Space.Point import NumHask.Space.Range import NumHask.Space.Types-import Prelude+import Protolude as P hiding (rotate)  -- $setup @@ -79,16 +78,18 @@ -- | pattern of Rect lowerx upperx lowery uppery pattern Rect :: a -> a -> a -> a -> Rect a pattern Rect a b c d = Rect' (Compose (Point (Range a b) (Range c d)))+ {-# COMPLETE Rect #-}  -- | pattern of Ranges xrange yrange pattern Ranges :: Range a -> Range a -> Rect a pattern Ranges a b = Rect' (Compose (Point a b))+ {-# COMPLETE Ranges #-}  instance (Show a) => Show (Rect a) where   show (Rect a b c d) =-    "Rect " <> show a <> " " <> show b <> " " <> show c <> " " <> show d+    "Rect " <> P.show a <> " " <> P.show b <> " " <> P.show c <> " " <> P.show d  instance Distributive Rect where   collect f x =@@ -100,7 +101,6 @@       getD (Rect _ _ _ d) = d  instance Representable Rect where-   type Rep Rect = (Bool, Bool)    tabulate f =@@ -115,7 +115,6 @@   (<>) = union  instance (Ord a) => Space (Rect a) where-   type Element (Rect a) = Point a    union (Ranges a b) (Ranges c d) = Ranges (a `union` c) (b `union` d)@@ -142,7 +141,6 @@   (|<|) s0 s1 = lower s1 `joinLeq` upper s0  instance (Ord a, Fractional a, Num a) => FieldSpace (Rect a) where-   type Grid (Rect a) = Point Int    grid o s n = (+ bool 0 (step / 2) (o == MidPos)) <$> posns@@ -206,7 +204,6 @@  -- | Numeric algebra based on interval arithmetioc for addition and unitRect and projection for multiplication instance (Fractional a, Num a, Eq a, Ord a) => Num (Rect a) where-   (+) = addRect    negate = fmap negate
src/NumHask/Space/Time.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} @@ -11,16 +12,18 @@     sensibleTimeGrid,     PosDiscontinuous (..),     placedTimeLabelDiscontinuous,+    placedTimeLabelContinuous,   ) where +import Control.Category (id) import qualified Control.Foldl as L-import qualified Data.Text as Text-import Data.Text (Text)+import Data.List (nub)+import Data.String (String)+import Data.Text (pack, unpack) import Data.Time-import GHC.Generics import NumHask.Space.Types-import Prelude+import Protolude  -- | parse text as per iso8601 --@@ -30,7 +33,7 @@ -- Just 2017-12-05 00:00:00 UTC parseUTCTime :: Text -> Maybe UTCTime parseUTCTime =-  parseTimeM False defaultTimeLocale (iso8601DateFormat Nothing) . Text.unpack+  parseTimeM False defaultTimeLocale (iso8601DateFormat Nothing) . unpack  -- | a step in time data TimeGrain@@ -203,7 +206,8 @@ -- | whether to include lower and upper times data PosDiscontinuous = PosInnerOnly | PosIncludeBoundaries --- | dates used for time series analysis or attached to charts are often discontinuous, but we want to smooth that reality over and show a continuous range on the axis+-- | Dates used for time series analysis or attached to charts are often discontinuous, but we want to smooth that reality over and show a continuous range on the axis.+-- -- The assumption with getSensibleTimeGrid is that there is a list of discountinuous UTCTimes rather than a continuous range.  Output is a list of index points for the original [UTCTime] and label tuples, and a list of unused list elements. -- -- >>> placedTimeLabelDiscontinuous PosIncludeBoundaries (Just "%d %b") 2 [UTCTime (fromGregorian 2017 12 6) 0, UTCTime (fromGregorian 2017 12 29) 0, UTCTime (fromGregorian 2018 1 31) 0, UTCTime (fromGregorian 2018 3 3) 0]@@ -220,9 +224,9 @@     (rem', inds) = L.fold (matchTimes tps') ts     inds' = laterTimes inds     fmt = case format of-      Just f -> Text.unpack f+      Just f -> unpack f       Nothing -> autoFormat grain-    labels = Text.pack . formatTime defaultTimeLocale fmt . snd <$> inds'+    labels = pack . formatTime defaultTimeLocale fmt . snd <$> inds'  autoFormat :: TimeGrain -> String autoFormat (Years x)@@ -252,6 +256,26 @@ laterTimes (x : xs) = L.fold (L.Fold step (x, []) (\(x0, x1) -> reverse $ x0 : x1)) xs   where     step ((n, a), rs) (na, aa) = if na == n then ((na, aa), rs) else ((na, aa), (n, a) : rs)++-- | A sensible time grid between two dates, projected onto (0,1) with no attempt to get finnicky.+--+-- >>> placedTimeLabelContinuous PosIncludeBoundaries (Just "%d %b") 2 (UTCTime (fromGregorian 2017 12 6) 0, UTCTime (fromGregorian 2017 12 29) 0)+-- [(0.0,"06 Dec"),(0.43478260869565216,"16 Dec"),(0.8695652173913043,"26 Dec"),(1.0,"29 Dec")]+placedTimeLabelContinuous :: PosDiscontinuous -> Maybe Text -> Int -> (UTCTime, UTCTime) -> [(Double, Text)]+placedTimeLabelContinuous posd format n (l, u) = zip tpsd labels+  where+    (grain, tps) = sensibleTimeGrid InnerPos n (l, u)+    tps' = case posd of+      PosInnerOnly -> tps+      PosIncludeBoundaries -> nub $ [l] <> tps <> [u]+    fmt = case format of+      Just f -> unpack f+      Nothing -> autoFormat grain+    labels = pack . formatTime defaultTimeLocale fmt <$> tps'+    l' = minimum tps'+    u' = maximum tps'+    r' = toDouble $ diffUTCTime u' l'+    tpsd = (/ r') . toDouble . flip diffUTCTime l <$> tps'  -- | compute a sensible TimeGrain and list of UTCTimes --
src/NumHask/Space/Types.hs view
@@ -28,7 +28,7 @@ where  import Protolude-import Data.Foldable+import Protolude.Partial (foldr1)  -- | Space is a continuous range of numbers that contains elements and has an upper and lower value. --@@ -39,9 +39,7 @@ -- > norm (norm a) = norm a -- > a |>| b == b |<| a -- > a |.| singleton a- class Space s where-   -- | the underlying element in the space   type Element s :: Type @@ -57,7 +55,6 @@    -- | the intersection of two spaces   intersection :: s -> s -> s-   default intersection :: (Ord (Element s)) => s -> s -> s   intersection a b = l >.< u     where@@ -66,7 +63,6 @@    -- | the union of two spaces   union :: s -> s -> s-   default union :: (Ord (Element s)) => s -> s -> s   union a b = l >.< u     where@@ -74,6 +70,7 @@       u = upper a `max` upper b    -- | Normalise a space so that+  --   -- > lower a \/ upper a == lower a   -- > lower a /\ upper a == upper a   norm :: s -> s@@ -83,7 +80,6 @@   infix 3 ...    (...) :: Element s -> Element s -> s-   default (...) :: (Ord (Element s)) => Element s -> Element s -> s   (...) a b = (a `min` b) >.< (a `max` b) @@ -96,7 +92,6 @@   infixl 7 |.|    (|.|) :: Element s -> s -> Bool-   default (|.|) :: (Ord (Element s)) => Element s -> s -> Bool   (|.|) a s = (a >= lower s) && (upper s >= a) @@ -104,7 +99,6 @@   infixl 7 |>|    (|>|) :: s -> s -> Bool-   default (|>|) :: (Ord (Element s)) => s -> s -> Bool   (|>|) s0 s1 =     lower s0 >= upper s1@@ -113,7 +107,6 @@   infixl 7 |<|    (|<|) :: s -> s -> Bool-   default (|<|) :: (Ord (Element s)) => s -> s -> Bool   (|<|) s0 s1 =     lower s1 <= upper s0@@ -162,7 +155,6 @@ -- > space1 (grid OuterPos s g) == s -- > getUnion (sconcat (Union <$> (gridSpace s g))) == s class (Space s, Num (Element s)) => FieldSpace s where-   type Grid s :: Type    -- | create equally-spaced elements across a space@@ -172,17 +164,18 @@   gridSpace :: s -> Grid s -> [s]  -- | Pos suggests where points should be placed in forming a grid across a field space.-data Pos =-  -- | include boundaries-  OuterPos |-  -- | don't include boundaries-  InnerPos |-  -- | include the lower boundary-  LowerPos |-  -- | include the upper boundary-  UpperPos |-  -- | use the mid-point of the space-  MidPos deriving (Show, Eq)+data Pos+  = -- | include boundaries+    OuterPos+  | -- | don't include boundaries+    InnerPos+  | -- | include the lower boundary+    LowerPos+  | -- | include the upper boundary+    UpperPos+  | -- | use the mid-point of the space+    MidPos+  deriving (Show, Eq)  -- | middle element of the space mid :: (Space s, Fractional (Element s)) => s -> Element s@@ -192,12 +185,14 @@ -- -- > project o n (lower o) = lower n -- > project o n (upper o) = upper n+-- > project o n (mid o) = mid n -- > project a a x = x project :: (Space s, Fractional (Element s)) => s -> s -> Element s -> Element s project s0 s1 p =   ((p - lower s0) / (upper s0 - lower s0)) * (upper s1 - lower s1) + lower s1  -- | the containing space of a non-empty Traversable+-- -- > all $ space1 a `contains` <$> a space1 :: (Space s, Traversable f) => f (Element s) -> s space1 = foldr1 union . fmap singleton
test/test.hs view
@@ -2,8 +2,8 @@  module Main where +import Protolude import Test.DocTest-import Prelude  main :: IO () main =