Copyright | (c) Ross Paterson 2011 |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | [email protected] |
Stability | provisional |
Portability | portable |
Safe Haskell | None |
Language | Haskell2010 |
Data.YAP.Algebra
Description
Classes corresponding to common structures from abstract algebra, defined as superclasses of the Haskell 2010 numeric classes, yielding the following class hierarchy (grey classes are unchanged):
Synopsis
- class AdditiveMonoid a where
- atimesIdempotent :: (ToInteger b, AdditiveMonoid a) => b -> a -> a
- timesCancelling :: (ToInteger a, AdditiveMonoid b) => a -> b -> b
- class AdditiveMonoid a => AbelianGroup a where
- (-) :: a -> a -> a
- negate :: a -> a
- gtimes :: (AbelianGroup b, ToInteger b) => b -> a -> a
- subtract :: AbelianGroup a => a -> a -> a
- gtimesIdempotent :: (ToInteger b, AbelianGroup a) => b -> a -> a
- class AdditiveMonoid a => Semiring a where
- (*) :: a -> a -> a
- one :: a
- fromNatural :: Natural -> a
- rescale :: a -> a -> (a, a, a -> a)
- class (AbelianGroup a, Semiring a) => Ring a where
- fromInteger :: Integer -> a
- class Semiring a => StandardAssociate a where
- stdAssociate :: a -> a
- stdUnit :: a -> a
- stdRecip :: a -> a
- class Semiring a => Euclidean a where
- div :: a -> a -> a
- mod :: a -> a -> a
- divMod :: a -> a -> (a, a)
- euclideanNorm :: a -> Natural
- gcd :: (Eq a, StandardAssociate a, Euclidean a) => a -> a -> a
- lcm :: (Eq a, StandardAssociate a, Euclidean a) => a -> a -> a
- bezout :: (Eq a, AbelianGroup a, StandardAssociate a, Euclidean a) => a -> a -> (a, a)
- extendedEuclid :: (Eq a, AbelianGroup a, StandardAssociate a, Euclidean a) => a -> a -> [(a, a, a, a)]
- class Semiring a => DivisionSemiring a where
- recip :: a -> a
- class DivisionSemiring a => Semifield a where
- (/) :: a -> a -> a
- class (Ring a, DivisionSemiring a) => DivisionRing a
- class (DivisionRing a, Semifield a) => Field a
- class Ring a => FromRational a where
- fromRational :: Rational -> a
- class (Ord a, Semiring a) => ToRational a where
- toRational :: a -> Rational
- class (StandardAssociate a, Euclidean a, ToRational a) => ToInteger a where
- class Semiring a => Differentiable a where
- derivative :: a -> a
- class Differentiable a => Integrable a where
- integral :: a -> a
- class AdditiveFunctor (f :: Type -> Type) where
- mapAdditive :: (AdditiveMonoid a, AdditiveMonoid b) => (a -> b) -> f a -> f b
Addition
class AdditiveMonoid a where Source #
A commutative associative binary operation with an identity.
Rationale:
- This is the common superclass of
AbelianGroup
andSemiring
. General monoids are also useful, but it is a common expectation that an operation denoted by+
is commutative. zero
is required because this class is insufficient for integer literals.- Ideally,
0
could be defined as equivalent tozero
, with other integer literals handled byfromNatural
.
Methods
(+) :: a -> a -> a infixl 6 Source #
An associative operation.
The identity of (
.+
)
atimes :: ToInteger b => b -> a -> a Source #
Sum of n
copies of x
. n
should be non-negative.
Instances
AdditiveMonoid Integer Source # | |
AdditiveMonoid Natural Source # | |
AdditiveMonoid Double Source # | |
AdditiveMonoid Float Source # | |
AdditiveMonoid Int Source # | |
AdditiveMonoid Word Source # | |
AdditiveMonoid a => AdditiveMonoid (Complex a) Source # | |
(Eq a, StandardAssociate a, Euclidean a) => AdditiveMonoid (Ratio a) Source # | |
AdditiveMonoid a => AdditiveMonoid (Product a) Source # | |
AdditiveMonoid a => AdditiveMonoid (Sum a) Source # | |
(AdditiveMonoid a, AdditiveMonoid b) => AdditiveMonoid (a, b) Source # | Direct product |
atimesIdempotent :: (ToInteger b, AdditiveMonoid a) => b -> a -> a Source #
Faster implementation of atimes
when addition is idempotent.
timesCancelling :: (ToInteger a, AdditiveMonoid b) => a -> b -> b Source #
Subtraction
class AdditiveMonoid a => AbelianGroup a where Source #
An Abelian group has a commutative associative binary operation with an identity and inverses.
Rationale:
Methods
(-) :: a -> a -> a infixl 6 Source #
Subtraction operator.
Inverse for (
(unary negation).+
)
gtimes :: (AbelianGroup b, ToInteger b) => b -> a -> a Source #
Sum of n
copies of x
.
Instances
AbelianGroup Integer Source # | |
AbelianGroup Double Source # | |
AbelianGroup Float Source # | |
AbelianGroup Int Source # | |
AbelianGroup Word Source # | |
AbelianGroup a => AbelianGroup (Complex a) Source # | |
(Eq a, StandardAssociate a, Euclidean a, Ring a) => AbelianGroup (Ratio a) Source # | |
AbelianGroup a => AbelianGroup (Product a) Source # | |
AbelianGroup a => AbelianGroup (Sum a) Source # | |
(AbelianGroup a, AbelianGroup b) => AbelianGroup (a, b) Source # | Direct product |
subtract :: AbelianGroup a => a -> a -> a Source #
gtimesIdempotent :: (ToInteger b, AbelianGroup a) => b -> a -> a Source #
Faster implementation of gtimes
when addition is idempotent.
Multiplication
class AdditiveMonoid a => Semiring a where Source #
A semiring: addition defines a commutative monoid, and multiplication defines a monoid and distributes over addition and zero. Multiplication is not guaranteed to be commutative.
Rationale:
Natural
is the key example of a type with multiplication but not subtraction, but there are many more.one
is required because this class is insufficient for integer literals.- In an ideal world, an integer literal
i
would be treated as equivalent to
and have typefromNatural
i(
. (The lexical syntax already permits only non-negative numbers.)Semiring
a) => a rescale
is available here with a trivial default definition so that some operations on complex numbers, whose direct definitions would often overflow onFloat
orDouble
components, can be defined for other types as well.
Minimal complete definition
(*), (one | fromNatural)
Methods
(*) :: a -> a -> a infixl 7 Source #
An associative operation that distributes over (+)
.
The identity of (
.*
)
fromNatural :: Natural -> a Source #
Instances
Semiring Integer Source # | |
Semiring Natural Source # | |
Semiring Double Source # | |
Semiring Float Source # | |
Semiring Int Source # | |
Semiring Word Source # | |
Ring a => Semiring (Complex a) Source # | |
(Eq a, StandardAssociate a, Euclidean a) => Semiring (Ratio a) Source # | |
Semiring a => Semiring (Product a) Source # | |
Semiring a => Semiring (Sum a) Source # | |
(Semiring a, Semiring b) => Semiring (a, b) Source # | Direct product |
class (AbelianGroup a, Semiring a) => Ring a where Source #
A ring: addition forms an Abelian group, and multiplication defines a monoid and distributes over addition. Multiplication is not guaranteed to be commutative.
Rationale:
- This is sufficient to define
fromInteger
, but often a much more efficient definition is available.
Minimal complete definition
Nothing
Methods
fromInteger :: Integer -> a Source #
Conversion from Integer
, the initial ring:
fromInteger
is the unique function preserving zero
, one
,
(
, +
)(
and -
)(
.*
)
An integer literal represents the application of the function
fromInteger
to the appropriate value of type Integer
,
so such literals have type (
.
(Ideally, they would represent an application of Ring
a) => afromNatural
,
and have type (
.)Semiring
a) => a
Instances
class Semiring a => StandardAssociate a where Source #
A cancellative commutative semiring with a designated canonical factoring of each value as the product of a unit (invertible value) and an associate.
Rationale:
- This normalization is required so that the results of operations
such as
gcd
andlcm
can be uniquely defined. In the original Prelude,abs
andsignum
were used for this, but they lack coherent definitions on many useful instances. - This class is usually used together with
Euclidean
, and generally has matching instances. Merging the two classes would be a possibility. That would allow a default definition ofstdAssociate
.
Methods
stdAssociate :: a -> a Source #
A representative associate:
- if
x
andy
are factors of each other, thenstdAssociate
x =stdAssociate
y stdAssociate
(stdAssociate
x) =stdAssociate
xstdAssociate
zero
=zero
stdAssociate
one
=one
For integral types,
is a non-negative integer.stdAssociate
x
multiplicative inverse of stdUnit
x
Instances
StandardAssociate Integer Source # | Units have absolute value 1. Standard associates are non-negative. |
StandardAssociate Natural Source # | The only unit is 1. |
StandardAssociate Int Source # | Units have absolute value 1. Standard associates are non-negative. |
StandardAssociate Word Source # | The only unit is 1. |
(Ring a, ToInteger a) => StandardAssociate (Complex a) Source # | Gaussian integers: units have magnitude 1; standard associates are natural numbers or in the positive quadrant. |
Division with remainder
class Semiring a => Euclidean a where Source #
A Euclidean semiring: a commutative semiring with Euclidean division, yielding a quotient and a remainder that is smaller than the divisor in a well-founded ordering. This is sufficient to implement Euclid's algorithm for the greatest common divisor.
Rationale:
- This class, together with
StandardAssociate
, is sufficient to definegcd
, and thus to define arithmetic operations on
.Ratio
a - The uniformity condition is required to make modular arithmetic work.
Non-integer examples include
(Gaussian integers) and polynomials.Complex
Integer
- The usual definition of a Euclidean domain assumes a ring, but
division with remainder can be defined in the absence of negation,
e.g. for
Natural
.
Minimal complete definition
(divMod | div, mod), euclideanNorm
Methods
div :: a -> a -> a infixl 7 Source #
mod :: a -> a -> a infixl 7 Source #
Remainder of division: for any d
that is not zero
,
n =
div
n d * d +mod
n dmod
(n + a*d) d =mod
n ddiv
zero
d =zero
- either
ismod
n dzero
or
.euclideanNorm
(mod
n d) <euclideanNorm
d
For integral types,
is a non-negative integer smaller
than the absolute value of mod
n dd
.
divMod :: a -> a -> (a, a) Source #
euclideanNorm :: a -> Natural Source #
A measure of the size of a non-zero value.
This may be undefined on zero
.
If the argument is non-zero, the value is positive.
Instances
gcd :: (Eq a, StandardAssociate a, Euclidean a) => a -> a -> a Source #
is a common factor of gcd
x yx
and y
such that
, andstdAssociate
(gcd
x y) =gcd
x y- any common factor of
x
andy
is a factor of
.gcd
x y
lcm :: (Eq a, StandardAssociate a, Euclidean a) => a -> a -> a Source #
is a common multiple of lcm
x yx
and y
such that
, andstdAssociate
(lcm
x y) =lcm
x y- any common multiple of
x
andy
is a multiple of
.lcm
x y
bezout :: (Eq a, AbelianGroup a, StandardAssociate a, Euclidean a) => a -> a -> (a, a) Source #
such that bezout
x y = (a, b)a*x + b*y =
(Bézout's identity).gcd
x y
In particular, if x
and y
are coprime (i.e.
),gcd
x y == one
b
is the multiplicative inverse ofy
modulox
.a
is the multiplicative inverse ofx
moduloy
.j*a*x + i*b*y
is equivalent toi
modulox
and toj
moduloy
(Chinese Remainder Theorem).
extendedEuclid :: (Eq a, AbelianGroup a, StandardAssociate a, Euclidean a) => a -> a -> [(a, a, a, a)] Source #
The list of quadruples \((q_i, r_i, s_i, t_i)\) generated by the extended Euclidean algorithm, which is a maximal list satisfying:
- \(r_{i-1} = q_i r_i + r_{i+1}\) with \(r_{i+1}\) smaller than \(r_i\), where \(r_0 = a\) and \(r_1 = b\), and
- \(r_i = s_i a + t_i b\).
The last \(r_i\) in the list is a greatest common divisor of \(a\) and \(b\), so that the second equation above becomes Bézout's identity.
Exact division
class Semiring a => DivisionSemiring a where Source #
A Semiring
in which all non-zero elements have multiplicative inverses.
Rationale:
- Quaternions have multiplicative inverses, but do not form a field, because multiplication is not commutative.
- Some semirings, such as the tropical semiring and its dual, support division but not subtraction.
Instances
DivisionSemiring Double Source # | |
DivisionSemiring Float Source # | |
Field a => DivisionSemiring (Complex a) Source # | |
(Eq a, StandardAssociate a, Euclidean a) => DivisionSemiring (Ratio a) Source # | |
class DivisionSemiring a => Semifield a where Source #
A commutative Semiring
in which all non-zero elements have
multiplicative inverses, so that division is uniquely defined.
Rationale:
- Some semirings, such as the tropical semiring and its dual, support division but not subtraction.
Minimal complete definition
Nothing
class (Ring a, DivisionSemiring a) => DivisionRing a Source #
A Ring
in which all non-zero elements have multiplicative inverses.
Rationale:
- Quaternions have multiplicative inverses, but multiplication is not commutative, so they do not have a well-defined division operation, and do not form a field.
Instances
DivisionRing Double Source # | |
Defined in Data.YAP.Algebra.Internal | |
DivisionRing Float Source # | |
Defined in Data.YAP.Algebra.Internal | |
Field a => DivisionRing (Complex a) Source # | |
Defined in Data.YAP.Algebra.Internal | |
(Eq a, StandardAssociate a, Euclidean a, Ring a) => DivisionRing (Ratio a) Source # | |
Defined in Data.YAP.Algebra.Internal |
class (DivisionRing a, Semifield a) => Field a Source #
A commutative Ring
in which all non-zero elements have
multiplicative inverses.
Rationale:
fromRational
needs to be in an independent class, becauseRational
cannot be embedded in finite fields.- While fields trivially support Euclidean division and standard associates, they are kept apart for backward compatibility.
Instances
Field Double Source # | |
Defined in Data.YAP.Algebra.Internal | |
Field Float Source # | |
Defined in Data.YAP.Algebra.Internal | |
Field a => Field (Complex a) Source # | |
Defined in Data.YAP.Algebra.Internal | |
(Eq a, StandardAssociate a, Euclidean a, Ring a) => Field (Ratio a) Source # | |
Defined in Data.YAP.Algebra.Internal |
Embeddings
These classes define one-to-one embeddings. In contrast,
the functions fromNatural
and fromInteger
(in Semiring
and
Ring
respectively) are not required to be one-to-one.
class Ring a => FromRational a where Source #
Rings extending Rational
.
Such a ring should have characteristic 0, i.e. no sum 1 + ... + 1
should equal zero.
Rationale:
- For
fromRational
to be injective, its domain must be infinite, which naturally excludes finite fields. IndeedRational
is initial in the category of infinite fields. (It's true thatFloat
andDouble
aren't infinite, but they aren't even additive monoids.) - Conversely, many rings that are not fields support embedding of rationals, e.g. polynomials and matrices.
Methods
fromRational :: Rational -> a Source #
Conversion from a Rational
(that is,
)
preserving Ratio
Integer
zero
, one
, (
, +
)(
and -
)(
.
Under the assumption that the ring has characteristic 0, this
implies that *
)fromRational
is injective.
For an infinite field, fromRational
is the unique function
preserving zero
, one
, (
, +
)(
, -
)(
and *
)(
./
)
A floating literal stands for an application of fromRational
to a value of type Rational
, so such literals have type
(
.FromRational
a) => a
Instances
FromRational Double Source # | |
Defined in Data.YAP.Algebra.Internal Methods fromRational :: Rational -> Double Source # | |
FromRational Float Source # | |
Defined in Data.YAP.Algebra.Internal Methods fromRational :: Rational -> Float Source # | |
FromRational a => FromRational (Complex a) Source # | |
Defined in Data.YAP.Algebra.Internal Methods fromRational :: Rational -> Complex a Source # | |
Integral a => FromRational (Ratio a) Source # | |
Defined in Data.YAP.Algebra.Internal Methods fromRational :: Rational -> Ratio a Source # | |
(FromRational a, FromRational b) => FromRational (a, b) Source # | Direct product |
Defined in Data.YAP.Algebra.Internal Methods fromRational :: Rational -> (a, b) Source # |
class (Ord a, Semiring a) => ToRational a where Source #
Types that can be faithfully embedded in Rational
.
Rationale:
Methods
toRational :: a -> Rational Source #
The rational equivalent of its argument with full precision
Instances
class (StandardAssociate a, Euclidean a, ToRational a) => ToInteger a where Source #
Types representing a contiguous set of integers, including 0, 1 and 2.
Rationale:
Methods
toInteger :: a -> Integer Source #
Conversion to Integer
, satisfying
fromInteger
(toInteger
x) = x
Differentiation and integration
class Semiring a => Differentiable a where Source #
A differential semiring
Methods
derivative :: a -> a Source #
A monoid homomorphism that satisfies
derivative
one
=zero
derivative
(a * b) = a*derivative
b +derivative
a*b
class Differentiable a => Integrable a where Source #
A differential semiring with anti-differentiation
Methods
A monoid homomorphism that is a pre-inverse of derivative
, i.e.
derivative
(integral
a) = a
Mapping
class AdditiveFunctor (f :: Type -> Type) where Source #
A functor on additive monoids
Methods
mapAdditive :: (AdditiveMonoid a, AdditiveMonoid b) => (a -> b) -> f a -> f b Source #