| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
AlgebraicPrelude
Contents
Description
This module provides drop-in replacement for module in base package,
based on algebraic hierarchy provided by
algebra package.
You can use this module with PreludeNoImplicitPrelude language option.
This module implicitly exports following modules:
Numeric.Algebra module, except
: this module exports Prelude'sfromIntegerto make number literals work properly. ForfromIntegerfromfromIntegeralgebrapackage, use.fromInteger'(is renamed to^)(, and^^)(is redefined as^).pow
- The module Numeric.Algebra.Unital.UnitNormalForm, except for
; hence its name is too general, we export it asnormalize.normaliseUnit Following modules are exported as-is:
Non-numeric part of this module is almost same as BasicPrelude. But the following combinators are not generalized from Prelude:
- type Rational = Fraction Integer
- fromInteger :: Num r => Integer -> r
- fromInteger' :: Ring r => Integer -> r
- fromRational :: DivisionRing r => Rational -> r
- normaliseUnit :: UnitNormalForm r => r -> r
- (^) :: Unital r => r -> Natural -> r
- (^^) :: Division r => r -> Integer -> r
- ifThenElse :: Bool -> a -> a -> a
- newtype WrapNum a = WrapNum {
- unwrapNum :: a
- newtype WrapFractional a = WrapFractional {
- unwrapFractional :: a
- newtype WrapIntegral a = WrapIntegral {
- unwrapIntegral :: a
- newtype WrapAlgebra a = WrapAlgebra {
- unwrapAlgebra :: a
- newtype Add a = Add {
- runAdd :: a
- newtype Mult a = Mult {
- runMult :: a
- class Num a where
- class (Real a, Enum a) => Integral a where
- toInteger :: Integral a => a -> Integer
- class (Num a, Ord a) => Real a where
- class Num a => Fractional a
- class Fractional a => Floating a where
- class (Real a, Fractional a) => RealFrac a where
- class (RealFrac a, Floating a) => RealFloat a where
Basic types and renamed operations
fromInteger :: Num r => Integer -> r Source #
To work with Num literals.
fromInteger' :: Ring r => Integer -> r Source #
algebra package's original .fromInteger
fromRational :: DivisionRing r => Rational -> r Source #
normaliseUnit :: UnitNormalForm r => r -> r Source #
Combinator to use with RebindableSyntax extensions.
ifThenElse :: Bool -> a -> a -> a Source #
Wrapper types for conversion between Num family
NumWrapping Prelude's numerical types to treat with
hierachy.Algebra
For or Field instances, see Euclidean and WrapIntegral.WrapField
N.B. This type provides a mean to convert from s
to Nums, but there is no guarantee that
Ring is actually ring.
For example, due to precision limitation,
WrapNum a even fails to be semigroup!
For another simpler example, even though WrapPreldue Double comes
with Natural instance, but it doesn't support Num,
so it cannot be negate.Group
Instances
| Num a => LeftModule Integer (WrapNum a) Source # | |
| Num a => LeftModule Natural (WrapNum a) Source # | |
| Num a => RightModule Integer (WrapNum a) Source # | |
| Num a => RightModule Natural (WrapNum a) Source # | |
| Eq a => Eq (WrapNum a) Source # | |
| Ord a => Ord (WrapNum a) Source # | |
| Read a => Read (WrapNum a) Source # | |
| Show a => Show (WrapNum a) Source # | |
| Num a => Commutative (WrapNum a) Source # | |
| Num a => Ring (WrapNum a) Source # | |
| Num a => Rig (WrapNum a) Source # | |
| (Num a, Eq a) => DecidableZero (WrapNum a) Source # | |
| Num a => Unital (WrapNum a) Source # | |
| Num a => Group (WrapNum a) Source # | |
| Num a => Multiplicative (WrapNum a) Source # | |
| Num a => Semiring (WrapNum a) Source # | |
| Num a => Monoidal (WrapNum a) Source # | |
| Num a => Additive (WrapNum a) Source # | |
| Num a => Abelian (WrapNum a) Source # | |
| Wrapped (WrapNum a0) Source # | |
| (~) * (WrapNum a0) t0 => Rewrapped (WrapNum a1) t0 Source # | |
| type Unwrapped (WrapNum a0) Source # | |
newtype WrapFractional a Source #
Similar to , but produces WrapNum instances from
Fields.Fractional
See also: and WrapIntegral.WrapNum
Constructors
| WrapFractional | |
Fields
| |
Instances
newtype WrapIntegral a Source #
Similar to , but produces WrapNum instances from
Euclideans.Integral
See also: and WrapFractional.WrapNum
Constructors
| WrapIntegral | |
Fields
| |
Instances
newtype WrapAlgebra a Source #
Turning types from into Prelude's Num instances.Algebra
N.B. Since 's Real constraint is too tight,
we won't provide the inverse of toRational and
provide WrapIntegral instance only.Fractional
Constructors
| WrapAlgebra | |
Fields
| |
Instances
| Eq a => Eq (WrapAlgebra a) Source # | |
| (DivisionRing a, UnitNormalForm a) => Fractional (WrapAlgebra a) Source # | |
| (Ring a, UnitNormalForm a) => Num (WrapAlgebra a) Source # | |
| Ord a => Ord (WrapAlgebra a) Source # | |
| Read a => Read (WrapAlgebra a) Source # | |
| Show a => Show (WrapAlgebra a) Source # | |
| Wrapped (WrapAlgebra a0) Source # | |
| (~) * (WrapAlgebra a0) t0 => Rewrapped (WrapAlgebra a1) t0 Source # | |
| type Unwrapped (WrapAlgebra a0) Source # | |
instances for Monoids.
N.B. Unlike Additive, WrapNum instance is
just inhereted from the unwrapped data.Num
Instances
| Eq a => Eq (Add a) Source # | |
| Num a => Num (Add a) Source # | |
| Ord a => Ord (Add a) Source # | |
| Read a => Read (Add a) Source # | |
| Show a => Show (Add a) Source # | |
| Additive a => Semigroup (Add a) Source # | |
| Monoidal a => Monoid (Add a) Source # | |
| Wrapped (Add a0) Source # | |
| (~) * (Add a0) t0 => Rewrapped (Add a1) t0 Source # | |
| type Unwrapped (Add a0) Source # | |
instances for Monoids.
N.B. Unlike Additive, WrapNum instance is
just inhereted from the unwrapped data.Num
Instances
| Eq a => Eq (Mult a) Source # | |
| Num a => Num (Mult a) Source # | |
| Ord a => Ord (Mult a) Source # | |
| Read a => Read (Mult a) Source # | |
| Show a => Show (Mult a) Source # | |
| Multiplicative a => Semigroup (Mult a) Source # | |
| Unital a => Monoid (Mult a) Source # | |
| Wrapped (Mult a0) Source # | |
| (~) * (Mult a0) t0 => Rewrapped (Mult a1) t0 Source # | |
| type Unwrapped (Mult a0) Source # | |
Old Prelude's Numeric type classes and functions, without confliction
Basic numeric class.
Methods
Absolute value.
Instances
| Num Int | |
| Num Int8 | |
| Num Int16 | |
| Num Int32 | |
| Num Int64 | |
| Num Integer | |
| Num Word | |
| Num Word8 | |
| Num Word16 | |
| Num Word32 | |
| Num Word64 | |
| Num Natural | |
| Num CDev | |
| Num CIno | |
| Num CMode | |
| Num COff | |
| Num CPid | |
| Num CSsize | |
| Num CGid | |
| Num CNlink | |
| Num CUid | |
| Num CCc | |
| Num CSpeed | |
| Num CTcflag | |
| Num CRLim | |
| Num Fd | |
| Num CChar | |
| Num CSChar | |
| Num CUChar | |
| Num CShort | |
| Num CUShort | |
| Num CInt | |
| Num CUInt | |
| Num CLong | |
| Num CULong | |
| Num CLLong | |
| Num CULLong | |
| Num CFloat | |
| Num CDouble | |
| Num CPtrdiff | |
| Num CSize | |
| Num CWchar | |
| Num CSigAtomic | |
| Num CClock | |
| Num CTime | |
| Num CUSeconds | |
| Num CSUSeconds | |
| Num CIntPtr | |
| Num CUIntPtr | |
| Num CIntMax | |
| Num CUIntMax | |
| Integral a => Num (Ratio a) | |
| Num a => Num (Identity a) | |
| Num a => Num (Min a) | |
| Num a => Num (Max a) | |
| RealFloat a => Num (Complex a) | |
| Num a => Num (Sum a) | |
| Num a => Num (Product a) | |
| Num a => Num (Mult a) # | |
| Num a => Num (Add a) # | |
| (Ring a, UnitNormalForm a) => Num (WrapAlgebra a) # | |
| Num a => Num (Op a b) | |
| Num a => Num (Const k a b) | |
| Num (f a) => Num (Alt k f a) | |
| Num a => Num (Tagged k s a) | |
class (Real a, Enum a) => Integral a where #
Integral numbers, supporting integer division.
Methods
integer division truncated toward negative infinity
integer modulus, satisfying
(x `div` y)*y + (x `mod` y) == x
conversion to Integer
Instances
class (Num a, Ord a) => Real a where #
Minimal complete definition
Methods
toRational :: a -> Rational #
the rational equivalent of its real argument with full precision
Instances
| Real Int | |
| Real Int8 | |
| Real Int16 | |
| Real Int32 | |
| Real Int64 | |
| Real Integer | |
| Real Word | |
| Real Word8 | |
| Real Word16 | |
| Real Word32 | |
| Real Word64 | |
| Real Natural | |
| Real CDev | |
| Real CIno | |
| Real CMode | |
| Real COff | |
| Real CPid | |
| Real CSsize | |
| Real CGid | |
| Real CNlink | |
| Real CUid | |
| Real CCc | |
| Real CSpeed | |
| Real CTcflag | |
| Real CRLim | |
| Real Fd | |
| Real CChar | |
| Real CSChar | |
| Real CUChar | |
| Real CShort | |
| Real CUShort | |
| Real CInt | |
| Real CUInt | |
| Real CLong | |
| Real CULong | |
| Real CLLong | |
| Real CULLong | |
| Real CFloat | |
| Real CDouble | |
| Real CPtrdiff | |
| Real CSize | |
| Real CWchar | |
| Real CSigAtomic | |
| Real CClock | |
| Real CTime | |
| Real CUSeconds | |
| Real CSUSeconds | |
| Real CIntPtr | |
| Real CUIntPtr | |
| Real CIntMax | |
| Real CUIntMax | |
| Integral a => Real (Ratio a) | |
| Real a => Real (Identity a) | |
| Real a => Real (Const k a b) | |
| Real a => Real (Tagged k s a) | |
class Num a => Fractional a #
Fractional numbers, supporting real division.
Minimal complete definition
fromRational, (recip | (/))
Instances
| Fractional CFloat | |
| Fractional CDouble | |
| Integral a => Fractional (Ratio a) | |
| Fractional a => Fractional (Identity a) | |
| RealFloat a => Fractional (Complex a) | |
| (DivisionRing a, UnitNormalForm a) => Fractional (WrapAlgebra a) # | |
| Fractional a => Fractional (Op a b) | |
| Fractional a => Fractional (Const k a b) | |
| Fractional a => Fractional (Tagged k s a) | |
class Fractional a => Floating a where #
Trigonometric and hyperbolic functions and related functions.
Minimal complete definition
pi, exp, log, sin, cos, asin, acos, atan, sinh, cosh, asinh, acosh, atanh
class (Real a, Fractional a) => RealFrac a where #
Extracting components of fractions.
Minimal complete definition
Methods
properFraction :: Integral b => a -> (b, a) #
The function properFraction takes a real fractional number x
and returns a pair (n,f) such that x = n+f, and:
nis an integral number with the same sign asx; andfis a fraction with the same type and sign asx, and with absolute value less than1.
The default definitions of the ceiling, floor, truncate
and round functions are in terms of properFraction.
truncate :: Integral b => a -> b #
returns the integer nearest truncate xx between zero and x
round :: Integral b => a -> b #
returns the nearest integer to round xx;
the even integer if x is equidistant between two integers
ceiling :: Integral b => a -> b #
returns the least integer not less than ceiling xx
floor :: Integral b => a -> b #
returns the greatest integer not greater than floor xx
class (RealFrac a, Floating a) => RealFloat a where #
Efficient, machine-independent access to the components of a floating-point number.
Minimal complete definition
floatRadix, floatDigits, floatRange, decodeFloat, encodeFloat, isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE
Methods
floatRadix :: a -> Integer #
a constant function, returning the radix of the representation
(often 2)
floatDigits :: a -> Int #
a constant function, returning the number of digits of
floatRadix in the significand
floatRange :: a -> (Int, Int) #
a constant function, returning the lowest and highest values the exponent may assume
decodeFloat :: a -> (Integer, Int) #
The function decodeFloat applied to a real floating-point
number returns the significand expressed as an Integer and an
appropriately scaled exponent (an Int). If
yields decodeFloat x(m,n), then x is equal in value to m*b^^n, where b
is the floating-point radix, and furthermore, either m and n
are both zero or else b^(d-1) <= , where abs m < b^dd is
the value of .
In particular, floatDigits x. If the type
contains a negative zero, also decodeFloat 0 = (0,0).
The result of decodeFloat (-0.0) = (0,0) is unspecified if either of
decodeFloat x or isNaN x is isInfinite xTrue.
encodeFloat :: Integer -> Int -> a #
encodeFloat performs the inverse of decodeFloat in the
sense that for finite x with the exception of -0.0,
.
uncurry encodeFloat (decodeFloat x) = x is one of the two closest representable
floating-point numbers to encodeFloat m nm*b^^n (or ±Infinity if overflow
occurs); usually the closer, but if m contains too many bits,
the result may be rounded in the wrong direction.
exponent corresponds to the second component of decodeFloat.
and for finite nonzero exponent 0 = 0x,
.
If exponent x = snd (decodeFloat x) + floatDigits xx is a finite floating-point number, it is equal in value to
, where significand x * b ^^ exponent xb is the
floating-point radix.
The behaviour is unspecified on infinite or NaN values.
significand :: a -> a #
The first component of decodeFloat, scaled to lie in the open
interval (-1,1), either 0.0 or of absolute value >= 1/b,
where b is the floating-point radix.
The behaviour is unspecified on infinite or NaN values.
scaleFloat :: Int -> a -> a #
multiplies a floating-point number by an integer power of the radix
True if the argument is an IEEE "not-a-number" (NaN) value
isInfinite :: a -> Bool #
True if the argument is an IEEE infinity or negative infinity
isDenormalized :: a -> Bool #
True if the argument is too small to be represented in
normalized format
isNegativeZero :: a -> Bool #
True if the argument is an IEEE negative zero
True if the argument is an IEEE floating point number
a version of arctangent taking two real floating-point arguments.
For real floating x and y, computes the angle
(from the positive x-axis) of the vector from the origin to the
point atan2 y x(x,y). returns a value in the range [atan2 y x-pi,
pi]. It follows the Common Lisp semantics for the origin when
signed zeroes are supported. , with atan2 y 1y in a type
that is RealFloat, should return the same value as .
A default definition of atan yatan2 is provided, but implementors
can provide a more accurate implementation.