Safe Haskell | Safe-Inferred |
---|---|
Language | GHC2021 |
Metric classes
Synopsis
- class Distributive (Mag a) => Basis a where
- type Absolute a = (Basis a, Mag a ~ a)
- type Sign a = (Basis a, Base a ~ a)
- type EndoBased a = (Basis a, Mag a ~ a, Base a ~ a)
- abs :: Absolute a => a -> a
- signum :: Sign a => a -> a
- distance :: (Basis a, Subtractive a) => a -> a -> Mag a
- class (Distributive coord, Distributive (Dir coord)) => Direction coord where
- data Polar a = Polar {}
- polar :: (Dir (Base a) ~ Mag a, Basis a, Direction (Base a)) => a -> Polar (Mag a)
- coord :: (Scalar m ~ Dir m, MultiplicativeAction m, Direction m) => Polar (Scalar m) -> m
- class (Eq a, Additive a) => Epsilon a where
- epsilon :: a
- nearZero :: (Epsilon a, Lattice a, Subtractive a) => a -> Bool
- aboutEqual :: (Epsilon a, Lattice a, Subtractive a) => a -> a -> Bool
- (~=) :: Epsilon a => (Lattice a, Subtractive a) => a -> a -> Bool
- newtype EuclideanPair a = EuclideanPair {
- euclidPair :: (a, a)
Documentation
class Distributive (Mag a) => Basis a where Source #
Basis
encapsulates the notion of magnitude (intuitively the quotienting of a higher-kinded number to a scalar one) and the basis on which the magnitude quotienting was performed. An instance needs to satisfy these laws:
\a -> magnitude a >= zero \a -> magnitude zero == zero \a -> a == magnitude a *| basis a \a -> magnitude (basis a) == one
The names chosen are meant to represent the spiritual idea of a basis rather than a specific mathematics. See https://en.wikipedia.org/wiki/Basis_(linear_algebra) & https://en.wikipedia.org/wiki/Norm_(mathematics) for some mathematical motivations.
>>>
magnitude (-0.5 :: Double)
0.5
>>>
basis (-0.5 :: Double)
-1.0
Instances
Basis Int16 Source # | |
Basis Int32 Source # | |
Basis Int64 Source # | |
Basis Int8 Source # | |
Basis Word16 Source # | |
Basis Word32 Source # | |
Basis Word64 Source # | |
Basis Word8 Source # | |
Basis Integer Source # | |
Basis Natural Source # | |
Basis Double Source # | |
Basis Float Source # | |
Basis Int Source # | |
Basis Word Source # | |
(ExpField a, Eq a) => Basis (EuclideanPair a) Source # | |
Defined in NumHask.Algebra.Metric type Mag (EuclideanPair a) Source # type Base (EuclideanPair a) Source # magnitude :: EuclideanPair a -> Mag (EuclideanPair a) Source # basis :: EuclideanPair a -> Base (EuclideanPair a) Source # | |
(Additive a, Multiplicative a) => Basis (Polar a) Source # | |
(ExpField a, Eq a) => Basis (Complex a) Source # | |
(Ord a, EndoBased a, Integral a, Ring a) => Basis (Ratio a) Source # | |
type Absolute a = (Basis a, Mag a ~ a) Source #
Basis where the domain and magnitude codomain are the same.
type EndoBased a = (Basis a, Mag a ~ a, Base a ~ a) Source #
Basis where the domain, magnitude codomain and basis codomain are the same.
abs :: Absolute a => a -> a Source #
The absolute value of a number.
\a -> abs a * signum a ~= a
>>>
abs (-1)
1
signum :: Sign a => a -> a Source #
The sign of a number.
>>>
signum (-1)
-1
abs zero == zero
, so any value for signum zero
is ok. We choose lawful neutral:
>>>
signum zero == zero
True
distance :: (Basis a, Subtractive a) => a -> a -> Mag a Source #
Distance, which combines the Subtractive notion of difference, with Basis.
distance a b >= zero distance a a == zero distance a b *| basis (a - b) == a - b
class (Distributive coord, Distributive (Dir coord)) => Direction coord where Source #
Convert between a "co-ordinated" or "higher-kinded" number and a direction.
ray . angle == basis magnitude (ray x) == one
Instances
TrigField a => Direction (EuclideanPair a) Source # | |
Defined in NumHask.Algebra.Metric type Dir (EuclideanPair a) Source # angle :: EuclideanPair a -> Dir (EuclideanPair a) Source # ray :: Dir (EuclideanPair a) -> EuclideanPair a Source # | |
TrigField a => Direction (Complex a) Source # | |
Something that has a magnitude and a direction, with both expressed as the same type.
Instances
Generic (Polar a) Source # | |
Show a => Show (Polar a) Source # | |
Eq a => Eq (Polar a) Source # | |
(Additive a, Multiplicative a) => Basis (Polar a) Source # | |
type Rep (Polar a) Source # | |
Defined in NumHask.Algebra.Metric type Rep (Polar a) = D1 ('MetaData "Polar" "NumHask.Algebra.Metric" "numhask-0.11.0.2-EPdqu9BAKP33Ss1khxo3uN" 'False) (C1 ('MetaCons "Polar" 'PrefixI 'True) (S1 ('MetaSel ('Just "radial") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a) :*: S1 ('MetaSel ('Just "azimuth") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a))) | |
type Base (Polar a) Source # | |
Defined in NumHask.Algebra.Metric | |
type Mag (Polar a) Source # | |
Defined in NumHask.Algebra.Metric |
polar :: (Dir (Base a) ~ Mag a, Basis a, Direction (Base a)) => a -> Polar (Mag a) Source #
Convert a higher-kinded number that has direction, to a Polar
coord :: (Scalar m ~ Dir m, MultiplicativeAction m, Direction m) => Polar (Scalar m) -> m Source #
Convert a Polar to a (higher-kinded) number that has a direction.
class (Eq a, Additive a) => Epsilon a where Source #
A small number, especially useful for approximate equality.
Nothing
Instances
nearZero :: (Epsilon a, Lattice a, Subtractive a) => a -> Bool Source #
Note that the constraint is Lattice rather than Ord allowing broader usage.
>>>
nearZero (epsilon :: Double)
True
>>>
nearZero (epsilon :: EuclideanPair Double)
True
aboutEqual :: (Epsilon a, Lattice a, Subtractive a) => a -> a -> Bool Source #
Approximate equality
>>>
aboutEqual zero (epsilon :: Double)
True
(~=) :: Epsilon a => (Lattice a, Subtractive a) => a -> a -> Bool infixl 4 Source #
About equal operator.
>>>
(1.0 + epsilon) ~= (1.0 :: Double)
True
newtype EuclideanPair a Source #
Two dimensional cartesian coordinates.
EuclideanPair | |
|