Safe Haskell | Safe-Inferred |
---|---|
Language | GHC2021 |
Synopsis
- newtype Rect a = Rect' (Compose Point Range a)
- padRect :: Subtractive a => a -> Rect a -> Rect a
- padSingletons :: Rect Double -> Rect Double
- singletonGuard :: Maybe (Rect Double) -> Rect Double
- data Point a = Point {}
- addp :: Point Double -> Point Double -> Point Double
- class Multiplicative a where
- one :: a
- class Additive a where
- zero :: a
- abs :: Absolute a => a -> a
- magnitude :: Basis a => a -> Mag a
- module NumHask.Space
Data Primitives
a rectangular space often representing a finite 2-dimensional or XY plane.
>>>
one :: Rect Double
Rect -0.5 0.5 -0.5 0.5
>>>
zero :: Rect Double
Rect 0.0 0.0 0.0 0.0
>>>
one + one :: Rect Double
Rect -1.0 1.0 -1.0 1.0
>>>
let a = Rect (-1.0) 1.0 (-2.0) 4.0
>>>
a
Rect -1.0 1.0 -2.0 4.0
>>>
a * one
Rect -1.0 1.0 -2.0 4.0
>>>
let (Ranges x y) = a
>>>
x
Range -1.0 1.0>>>
y
Range -2.0 4.0>>>
fmap (+1) (Rect 1 2 3 4)
Rect 2 3 4 5
as a Space instance with Points as Elements
>>>
project (Rect 0.0 1.0 (-1.0) 0.0) (Rect 1.0 4.0 10.0 0.0) (Point 0.5 1.0)
Point 2.5 -10.0>>>
gridSpace (Rect 0.0 10.0 0.0 1.0) (Point (2::Int) (2::Int))
[Rect 0.0 5.0 0.0 0.5,Rect 0.0 5.0 0.5 1.0,Rect 5.0 10.0 0.0 0.5,Rect 5.0 10.0 0.5 1.0]>>>
grid MidPos (Rect 0.0 10.0 0.0 1.0) (Point (2::Int) (2::Int))
[Point 2.5 0.25,Point 2.5 0.75,Point 7.5 0.25,Point 7.5 0.75]
Instances
Representable Rect | |
Foldable Rect | |
Defined in NumHask.Space.Rect fold :: Monoid m => Rect m -> m # foldMap :: Monoid m => (a -> m) -> Rect a -> m # foldMap' :: Monoid m => (a -> m) -> Rect a -> m # foldr :: (a -> b -> b) -> b -> Rect a -> b # foldr' :: (a -> b -> b) -> b -> Rect a -> b # foldl :: (b -> a -> b) -> b -> Rect a -> b # foldl' :: (b -> a -> b) -> b -> Rect a -> b # foldr1 :: (a -> a -> a) -> Rect a -> a # foldl1 :: (a -> a -> a) -> Rect a -> a # elem :: Eq a => a -> Rect a -> Bool # maximum :: Ord a => Rect a -> a # | |
Traversable Rect | |
Applicative Rect | |
Functor Rect | |
Distributive Rect | |
Ord a => Semigroup (Rect a) | |
Generic (Rect a) | |
Show a => Show (Rect a) | |
Eq a => Eq (Rect a) | |
Additive a => Additive (Rect a) | Numeric algebra based on interval arithmetioc for addition and unitRect and projection for multiplication >>> one + one :: Rect Double Rect -1.0 1.0 -1.0 1.0 |
Subtractive a => Subtractive (Rect a) | |
(Ord a, Field a) => Basis (Rect a) | |
(Ord a, Field a) => Divisive (Rect a) | |
(Ord a, Field a) => Multiplicative (Rect a) | |
(FromIntegral a Int, Field a, Ord a) => FieldSpace (Rect a) | |
Ord a => Space (Rect a) | |
Defined in NumHask.Space.Rect lower :: Rect a -> Element (Rect a) # upper :: Rect a -> Element (Rect a) # singleton :: Element (Rect a) -> Rect a # intersection :: Rect a -> Rect a -> Rect a # union :: Rect a -> Rect a -> Rect a # normalise :: Rect a -> Rect a # (...) :: Element (Rect a) -> Element (Rect a) -> Rect a # (>.<) :: Element (Rect a) -> Element (Rect a) -> Rect a # (|.|) :: Element (Rect a) -> Rect a -> Bool # | |
type Rep Rect | |
Defined in NumHask.Space.Rect | |
type Rep (Rect a) | |
Defined in NumHask.Space.Rect | |
type Base (Rect a) | |
Defined in NumHask.Space.Rect | |
type Mag (Rect a) | |
Defined in NumHask.Space.Rect | |
type Element (Rect a) | |
Defined in NumHask.Space.Rect | |
type Grid (Rect a) | |
Defined in NumHask.Space.Rect |
padRect :: Subtractive a => a -> Rect a -> Rect a Source #
Additive pad (or frame or buffer) a Rect.
>>>
padRect 1 one
Rect -1.5 1.5 -1.5 1.5
padSingletons :: Rect Double -> Rect Double Source #
Pad a Rect to remove singleton dimensions.
Attempting to scale a singleton dimension of a Rect is a common bug.
Due to the use of scaling, and thus zero dividing, this is a common exception to guard against.
>>>
project (Rect 0 0 0 1) one (Point 0 0)
Point NaN -0.5
>>>
project (padSingletons (Rect 0 0 0 1)) one (Point 0 0)
Point 0.0 -0.5
singletonGuard :: Maybe (Rect Double) -> Rect Double Source #
Guard against an upstream Nothing or a singleton dimension
A 2-dimensional Point of a's
In contrast with a tuple, a Point is functorial over both arguments.
>>>
let p = Point 1 1
>>>
p + p
Point 2 2>>>
(2*) <$> p
Point 2 2
A major reason for this bespoke treatment (compared to just using linear, say) is that Points do not have maximums and minimums but they do form a lattice, and this is useful for folding sets of points to find out the (rectangular) Space they occupy.
>>>
Point 0 1 /\ Point 1 0
Point 0 0>>>
Point 0 1 \/ Point 1 0
Point 1 1
This is used extensively in chart-svg to ergonomically obtain chart areas.
unsafeSpace1 [Point 1 0, Point 0 1] :: Rect Double
Rect 0.0 1.0 0.0 1.0
Instances
addp :: Point Double -> Point Double -> Point Double Source #
add Points, dimension-wise
>>>
Point 1 1 `addp` Point 0 2
Point 1.0 3.0
NumHask Exports
Note that (+) and (*) from numhask are not actually re-exported.
class Multiplicative a where #
For practical reasons, we begin the class tree with Additive
and Multiplicative
. Starting with Associative
and Unital
, or using Semigroup
and Monoid
from base tends to confuse the interface once you start having to disinguish between (say) monoidal addition and monoidal multiplication.
\a -> one * a == a
\a -> a * one == a
\a b c -> (a * b) * c == a * (b * c)
By convention, (*) is regarded as not necessarily commutative, but this is not universal, and the introduction of another symbol which means commutative multiplication seems a bit dogmatic.
>>>
one * 2
2
>>>
2 * 3
6
Instances
Multiplicative Int16 | |
Multiplicative Int32 | |
Multiplicative Int64 | |
Multiplicative Int8 | |
Multiplicative Word16 | |
Multiplicative Word32 | |
Multiplicative Word64 | |
Multiplicative Word8 | |
Multiplicative Integer | |
Multiplicative Natural | |
Multiplicative Bool | |
Multiplicative Double | |
Multiplicative Float | |
Multiplicative Int | |
Multiplicative Word | |
Multiplicative a => Multiplicative (EuclideanPair a) | |
Defined in NumHask.Algebra.Metric (*) :: EuclideanPair a -> EuclideanPair a -> EuclideanPair a # one :: EuclideanPair a # | |
(Subtractive a, Multiplicative a) => Multiplicative (Complex a) | |
(Ord a, EndoBased a, Integral a, Ring a) => Multiplicative (Ratio a) | |
Multiplicative a => Multiplicative (Point a) | |
(Field a, Ord a) => Multiplicative (Range a) | |
(Ord a, Field a) => Multiplicative (Rect a) | |
Multiplicative b => Multiplicative (a -> b) | |
Defined in NumHask.Algebra.Multiplicative | |
(Multiplicative a, Distributive a, Subtractive a, KnownNat m, HasShape '[m, m]) => Multiplicative (Matrix m m a) | |
or Addition
For practical reasons, we begin the class tree with Additive
. Starting with Associative
and Unital
, or using Semigroup
and Monoid
from base tends to confuse the interface once you start having to disinguish between (say) monoidal addition and monoidal multiplication.
\a -> zero + a == a
\a -> a + zero == a
\a b c -> (a + b) + c == a + (b + c)
\a b -> a + b == b + a
By convention, (+) is regarded as commutative, but this is not universal, and the introduction of another symbol which means non-commutative addition seems a bit dogmatic.
>>>
zero + 1
1
>>>
1 + 1
2
Instances
Additive Int16 | |
Additive Int32 | |
Additive Int64 | |
Additive Int8 | |
Additive Word16 | |
Additive Word32 | |
Additive Word64 | |
Additive Word8 | |
Additive Integer | |
Additive Natural | |
Additive Bool | |
Additive Double | |
Additive Float | |
Additive Int | |
Additive Word | |
Additive a => Additive (EuclideanPair a) | |
Defined in NumHask.Algebra.Metric (+) :: EuclideanPair a -> EuclideanPair a -> EuclideanPair a # zero :: EuclideanPair a # | |
Additive a => Additive (Complex a) | |
(Ord a, EndoBased a, Integral a, Ring a) => Additive (Ratio a) | |
Additive a => Additive (Point a) | |
(Additive a, Ord a) => Additive (Range a) | |
Additive a => Additive (Rect a) | Numeric algebra based on interval arithmetioc for addition and unitRect and projection for multiplication >>> one + one :: Rect Double Rect -1.0 1.0 -1.0 1.0 |
Additive b => Additive (a -> b) | |
Defined in NumHask.Algebra.Additive | |
(Additive a, HasShape s) => Additive (Array s a) | |
The absolute value of a number.
\a -> abs a * signum a ~= a
>>>
abs (-1)
1
Re-exports
module NumHask.Space