numhask-range 0.0.1 → 0.0.2

raw patch · 5 files changed

+88/−80 lines, 5 filesdep ~numhaskPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: numhask

API changes (from Hackage documentation)

Files

• numhask-range.cabal +3/−3
• src/NumHask/Range.hs +49/−41
• src/NumHask/Rect.hs +30/−27
• stack.yaml +2/−2
• test/test.hs +4/−7

@@ -1,7 +1,7 @@ name:   numhask-range version:-  0.0.1+  0.0.2 synopsis:   see readme.md description:@@ -38,7 +38,7 @@     NumHask.Rect   build-depends:     base >= 4.7 && < 5,-    numhask,+    numhask >= 0.0.4,     protolude,     lens,     foldl,@@ -101,7 +101,7 @@     tasty-hspec,     tasty-quickcheck,     tasty-smallcheck,-    numhask+    numhask >= 0.0.4   default-extensions:     NoImplicitPrelude,     UnicodeSyntax,

@@ -1,11 +1,13 @@-{-# LANGUAGE IncoherentInstances #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ExtendedDefaultRules #-} {-# OPTIONS_GHC -Wall #-} +-- | A 'Range' a is a tuple representing an interval of a number space.  A Range can be thought of as consisting of a low and high value, though low<high isn't strictly enforced, allowing a negative space so to speak.+-- The library uses the 'NumHask' classes and thus most of the usual arithmetic operators can be used.+ module NumHask.Range   ( Range(..)   , (...)-  , posit   , low   , high   , mid@@ -13,15 +15,14 @@   , element   , singleton   , singular-  , mirrored   , intersection   , contains   , range-  , rescaleP-  , TickPos(..)-  , ticks-  , ticksSensible-  , fromTicks+  , project+  , LinearPos(..)+  , linearSpace+  , linearSpaceSensible+  , fromLinearSpace  ) where  import NumHask.Prelude@@ -30,23 +31,25 @@ import qualified Control.Foldl as L import Test.QuickCheck --- | a range represented by a (minimum, maximum) tuple--- very similar to https://hackage.haskell.org/package/intervals-0.7.2 but the--- metaphor and purpose there is closer to a fuzzy value around a central point.+-- | a newtype wrapped (a, a) tuple newtype Range a = Range { range_ :: (a, a) }   deriving (Eq, Ord, Show, Functor) +-- | alternative constructor (...) :: Ord a => a -> a -> Range a a ... b   | a <= b = Range (a, b)   | otherwise = Range (b, a) +-- | lens for the fst of the tuple low :: Lens' (Range a) a low = lens (\(Range (l,_)) -> l) (\(Range (_,u)) l -> Range (l,u)) +-- | lens for the snd of the tuple high :: Lens' (Range a) a high = lens (\(Range (_,u)) -> u) (\(Range (l,_)) u -> Range (l,u)) +-- | mid-value lens mid ::     (BoundedField a) =>     Lens' (Range a) a@@ -55,6 +58,7 @@     plushom     (\r m -> Range (m - plushom r, m + plushom r)) +-- | range width lens width ::     (BoundedField a) =>     Lens' (Range a) a@@ -63,16 +67,13 @@     (\(Range (l,u)) -> (u-l))     (\r w -> Range (plushom r - w/two, plushom r + w/two)) -instance (Ord a, Arbitrary a) => Arbitrary (Range a) where+instance (Arbitrary a) => Arbitrary (Range a) where     arbitrary = do         a <- arbitrary         b <- arbitrary-        pure (posit (Range (a,b)))--posit :: (Ord a) => Range a -> Range a-posit r@(Range (l,u))  = if l<=u then r else Range (u,l)+        pure (Range (a,b)) --- | the convex hull as plus seems like a natural choice, given the cute zero definition.+-- | choosing the convex hull as plus seems like a natural choice, given the cute zero definition. instance (Ord a) => AdditiveMagma (Range a) where     plus (Range (l0,u0)) (Range (l1,u1)) = Range (min l0 l1, max u0 u1) @@ -90,6 +91,12 @@     mempty = zero     mappend = (<>) +instance (Ord a) => AdditiveInvertible (Range a)+    where+        negate (Range (l,u)) = Range (u,l)++instance (BoundedField a, Ord a) => AdditiveGroup (Range a)+ -- | natural interpretation of a `Range a` as an `a` is the mid-point instance (BoundedField a) =>     AdditiveHomomorphic (Range a) a where@@ -100,7 +107,7 @@     AdditiveHomomorphic a (Range a) where     plushom a = singleton a --- | times may well be some sort of affine transformation lurking under the hood+-- | times may well be some sort of affine projection lurking under the hood instance (BoundedField a) => MultiplicativeMagma (Range a) where     times a b = Range (m - r/two, m + r/two)         where@@ -128,6 +135,10 @@ instance (Ord a, BoundedField a) => MultiplicativeRightCancellative (Range a) instance (Ord a, BoundedField a) => MultiplicativeLeftCancellative (Range a) +instance (BoundedField a, Ord a) => Signed (Range a) where+    sign (Range (l,u)) = if u >= l then one else negate one+    abs (Range (l,u)) = if u >= l then Range (l,u) else Range (u,l)+ instance (AdditiveGroup a) => Normed (Range a) a where     size (Range (l, u)) = u-l @@ -158,11 +169,6 @@ singular :: (Eq a) => Range a -> Bool singular (Range (l,u)) = l==u --- | is the range low higher than the high--- there well may be an interesting complex-like set of operations on mirrored ranges-mirrored :: (Ord a) => Range a -> Bool-mirrored (Range (l,u)) = l>u- intersection :: (Ord a) => Range a -> Range a -> Range a intersection a b =     Range (max (view low a) (view low b), min (view high a) (view high b))@@ -174,21 +180,21 @@ range :: (Foldable f, Ord a, BoundedField a) => f a -> Range a range = L.fold (L.Fold (\x a -> x + singleton a) zero id) --- | `rescaleP rold rnew p` rescales a data point from an old range to a new range--- rescaleP o n (view low o) == view low n--- rescaleP o n (view high o) == view high n--- rescaleP a a == id-rescaleP :: (Field b) => Range b -> Range b -> b -> b-rescaleP (Range (l0,u0)) (Range (l1,u1)) p =+-- | project a data point from an old range to a new range+-- project o n (view low o) == view low n+-- project o n (view high o) == view high n+-- project a a == id+project :: (Field b) => Range b -> Range b -> b -> b+project (Range (l0,u0)) (Range (l1,u1)) p =     ((p-l0)/(u0-l0)) * (u1-l1) + l1 --- * ticks are a series of `a`s constructued from a `Range a`--- | where on the `Range` should the ticks be placed-data TickPos = OuterPos | InnerPos | LowerPos | UpperPos | MidPos deriving (Eq)+-- * linear+-- | overns where data points go on the range+data LinearPos = OuterPos | InnerPos | LowerPos | UpperPos | MidPos deriving (Eq) --- | turn a range into a ist of n `a`s, that are (view width x/n) apart-ticks :: (Field a, FromInteger a) => TickPos -> Range a -> Int -> [a]-ticks o (Range (l, u)) n = (+ if o==MidPos then step/two else zero) <$> posns+-- | turn a range into a list of n equally-spaced `a`s+linearSpace :: (Field a, FromInteger a) => LinearPos -> Range a -> Int -> [a]+linearSpace o (Range (l, u)) n = (+ if o==MidPos then step/two else zero) <$> posns   where     posns = (l +) . (step *) . fromIntegral <$> [i0..i1]     step = (u - l)/fromIntegral n@@ -201,8 +207,10 @@  -- | turn a range into n `a`s pleasing to human sense and sensibility -- the `a`s may well lie outside the original range as a result-ticksSensible :: (Fractional a, Ord a, FromInteger a, QuotientField a, ExpRing a, MultiplicativeGroup a) => TickPos -> Range a -> Int -> [a]-ticksSensible tp (Range (l, u)) n = (+ if tp==MidPos then step/two else zero) <$> posns+linearSpaceSensible :: (Fractional a, Ord a, FromInteger a, QuotientField a, ExpField a) =>+    LinearPos -> Range a -> Int -> [a]+linearSpaceSensible tp (Range (l, u)) n =+    (+ if tp==MidPos then step/two else zero) <$> posns   where     posns = (first' +) . (step *) . fromIntegral <$> [i0..i1]     span = u - l@@ -225,8 +233,8 @@  -- | take a list of (ascending) `a`s and make some (ascending) ranges -- based on OuterPos--- fromTicks . ticks OuterPos == id--- ticks OuterPos . fromTicks == id-fromTicks :: [a] -> [Range a]-fromTicks as = zipWith (curry Range) as (drop 1 as)+-- fromLinearSpace . linearSpace OuterPos == id+-- linearSpace OuterPos . fromLinearSpace == id+fromLinearSpace :: [a] -> [Range a]+fromLinearSpace as = zipWith (curry Range) as (drop 1 as) 

@@ -1,11 +1,9 @@-{-# LANGUAGE IncoherentInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wall #-}  module NumHask.Rect   ( Rect(..)   , rect-  , positRect   , corners   , midRect   , elementRect@@ -13,11 +11,10 @@   , singularRect   , intersectionRect   , containsRect-  , rescaleP   , rangeR2s   , scaleR2s   , rangeRects-  , rescaleRect+  , projectRect   , scaleRects   , scaleRectss   , gridP@@ -43,9 +40,6 @@     toRect (V4 x y z w) = Rect $ V2 (Range (x,z)) (Range (y,w))     toV4 (Rect (V2 (Range (x,z)) (Range (y,w)))) = V4 x y z w -positRect :: (Ord a) => Rect a -> Rect a-positRect (Rect (V2 x y)) = Rect (V2 (posit x) (posit y))- -- | a convex hull approach instance (Ord a) => AdditiveMagma (Rect a) where     plus (Rect (V2 ax ay)) (Rect (V2 bx yb)) =@@ -65,6 +59,11 @@     mempty = zero     mappend = (<>) +instance (Ord a) => AdditiveInvertible (Rect a) where+    negate (Rect (V2 x y)) = Rect (V2 (negate x) (negate y))++instance (BoundedField a, Ord a) => AdditiveGroup (Rect a)+ -- | natural interpretation of an `a` as an `Rect a` instance (Ord a) =>     AdditiveHomomorphic (V2 a) (Rect a) where@@ -82,6 +81,10 @@ instance (Ord a, BoundedField a) => MultiplicativeLeftCancellative (Rect a) instance (Ord a, BoundedField a) => MultiplicativeRightCancellative (Rect a) +instance (BoundedField a, Ord a) => Signed (Rect a) where+    sign (Rect (V2 a b)) = Rect (V2 (sign a) (sign b))+    abs (Rect (V2 a b)) = Rect (V2 (abs a) (abs b))+ instance (AdditiveGroup a) => Normed (Rect a) (V2 a) where     size (Rect (V2 x y)) = V2 (size x) (size y) @@ -123,30 +126,30 @@     g (f (r a)) -> Rect a rangeR2s f = foldMap rangeR2 f --- | rescales a container of r2's-rescaleR2 :: (R2 r, Field a, Functor f) =>+-- | project a container of r2 points from an old Rect to a new one+projectR2 :: (R2 r, Field a, Functor f) =>     Rect a -> Rect a -> f (r a) -> f (r a)-rescaleR2 (Rect (V2 rx ry)) (Rect (V2 rx' ry')) qs =-    (over _x (rescaleP rx rx') . over _y (rescaleP ry ry')) <$> qs+projectR2 (Rect (V2 rx ry)) (Rect (V2 rx' ry')) qs =+    (over _x (project rx rx') . over _y (project ry ry')) <$> qs --- | scale a double container of r2s from the current range+-- | project a double container of r2s from the current Rect range scaleR2s ::     (R2 r, BoundedField a, Traversable f, Traversable g, Ord a) =>     Rect a -> g (f (r a)) -> g (f (r a))-scaleR2s xy qss = rescaleR2 (rangeR2s qss) xy <$> qss+scaleR2s xy qss = projectR2 (rangeR2s qss) xy <$> qss --- | rescales a Rect from an old Rect range to a new one-rescaleRect :: (Field a) =>+-- | project a Rect from an old Rect range to a new one+projectRect :: (Field a) =>     Rect a -> Rect a -> Rect a -> Rect a-rescaleRect (Rect (V2 rx ry)) (Rect (V2 rx' ry')) (Rect (V2 rx0 ry0)) =-    Rect (V2 (rescaleP rx rx' <$> rx0) (rescaleP ry ry' <$> ry0))+projectRect (Rect (V2 rx ry)) (Rect (V2 rx' ry')) (Rect (V2 rx0 ry0)) =+    Rect (V2 (project rx rx' <$> rx0) (project ry ry' <$> ry0)) --- | rescales a container of Rects from an old Rect range to a new one-rescaleRects :: (Field a, Functor f) =>+-- | project a container of Rects from an old Rect range to a new one+projectRects :: (Field a, Functor f) =>     Rect a -> Rect a -> f (Rect a) -> f (Rect a)-rescaleRects o n f = rescaleRect o n <$> f+projectRects o n f = projectRect o n <$> f --- | the range of a container of Rects+-- | the range Rect of a container of Rects rangeRects :: (Ord a, BoundedField a, Traversable f) =>     f (Rect a) -> Rect a rangeRects f = fold f@@ -155,25 +158,25 @@ scaleRects ::     (BoundedField a, Traversable f, Ord a) =>     Rect a -> f (Rect a) -> f (Rect a)-scaleRects xy f = rescaleRects (fold f) xy f+scaleRects xy f = projectRects (fold f) xy f  -- | scale a double container of Rects from the current range scaleRectss ::     (BoundedField a, Traversable f, Traversable g, Ord a) =>     Rect a -> g (f (Rect a)) -> g (f (Rect a))-scaleRectss xy g = rescaleRects (fold $ fold <$> g) xy <$> g+scaleRectss xy g = projectRects (fold $ fold <$> g) xy <$> g  -- | grid points on a rectange, divided up by a V2 Int-gridP :: (Field a, FromInteger a) => TickPos -> Rect a -> V2 Int -> [V2 a]+gridP :: (Field a, FromInteger a) => LinearPos -> Rect a -> V2 Int -> [V2 a] gridP tp (Rect (V2 rX rY)) (V2 stepX stepY) =-    [V2 x y | x <- ticks tp rX stepX, y <- ticks tp rY stepY]+    [V2 x y | x <- linearSpace tp rX stepX, y <- linearSpace tp rY stepY]  -- | a rectangle divided up by a V2 Int, making a list of smaller rectangles grid :: (BoundedField a, FromInteger a) => Rect a -> V2 Int -> [Rect a] grid (Rect (V2 rX rY)) (V2 stepX stepY) =     [ Rect (V2 (Range (x,x+sx)) (Range (y,y+sy)))-    | x <- ticks LowerPos rX stepX-    , y <- ticks LowerPos rY stepY+    | x <- linearSpace LowerPos rX stepX+    , y <- linearSpace LowerPos rY stepY     ]   where     sx = view width rX / fromIntegral stepX

@@ -1,7 +1,7 @@-resolver: lts-7.19+resolver: lts-8.9  packages: - '.'  extra-deps:-- numhask-0.0.1+- numhask-0.0.4

@@ -5,12 +5,9 @@  import NumHask.Prelude import NumHask.Range-import NumHask.Histogram-import NumHask.Rect -import Test.Tasty (TestName, TestTree, testGroup, defaultMain)+import Test.Tasty (TestName, TestTree, testGroup, defaultMain, localOption) import Test.Tasty.QuickCheck-import Test.Tasty.Hspec  data LawArity a =     Nonary Bool |@@ -34,8 +31,8 @@ testRange = testGroup "Data.Range" $ testLawOf ([]::[Range Double]) <$> rangeLaws  main :: IO ()-main = do-    defaultMain $ testGroup "range" [testRange]+main =+    defaultMain $ testGroup "range" [localOption (QuickCheckTests 1000) testRange]  rangeLaws :: [Law (Range Double)] rangeLaws =@@ -43,7 +40,7 @@     , ("left id: zero + a = a", Unary (\a -> zero + a == a))     , ("right id: a + zero = a", Unary (\a -> a + zero == a))     , ("commutative: a + b == b + a", Binary (\a b -> a + b == b + a))-    , ("associative: a `times` (b `times` c) = (a `times` b) `times` c", Ternary (\a b c -> fuzzyeq 1e-4 ((a `times` b) `times` c) (a `times` (b `times` c))))+    , ("associative: a `times` (b `times` c) = (a `times` b) `times` c", Failiary $ expectFailure . (\a b c -> ((a `times` b) `times` c) == (a `times` (b `times` c))))     , ("left id: one * a = a", Unary (\a -> fuzzyeq 1e-8 (one `times` a) a))     , ("right id: a * one = a", Unary (\a -> fuzzyeq 1e-8 (a `times` one) a))     , ("commutative: a * b == b * a", Failiary $ expectFailure . (\a b -> a `times` b == b `times` a))