NumericPrelude-0.0: An experimental alternative hierarchy of numeric type classesContentsIndex
NumericPrelude
Synopsis
(+) :: C a => a -> a -> a
(-) :: C a => a -> a -> a
negate :: C a => a -> a
zero :: C a => a
subtract :: C a => a -> a -> a
sum :: C a => [a] -> a
sum1 :: C a => [a] -> a
isZero :: C a => a -> Bool
(*) :: C a => a -> a -> a
one :: C a => a
fromInteger :: C a => Integer -> a
(^) :: C a => a -> Integer -> a
ringPower :: (C a, ToInteger b) => b -> a -> a
sqr :: C a => a -> a
product :: C a => [a] -> a
product1 :: C a => [a] -> a
div :: C a => a -> a -> a
mod :: C a => a -> a -> a
divMod :: C a => a -> a -> (a, a)
divides :: (C a, C a) => a -> a -> Bool
even :: (C a, C a) => a -> Bool
odd :: (C a, C a) => a -> Bool
(/) :: C a => a -> a -> a
recip :: C a => a -> a
fromRational' :: C a => Rational -> a
(^-) :: C a => a -> Integer -> a
fieldPower :: (C a, ToInteger b) => b -> a -> a
fromRational :: C a => Rational -> a
(^/) :: C a => a -> Rational -> a
sqrt :: C a => a -> a
pi :: C a => a
exp :: C a => a -> a
log :: C a => a -> a
logBase :: C a => a -> a -> a
(**) :: C a => a -> a -> a
sin :: C a => a -> a
cos :: C a => a -> a
tan :: C a => a -> a
asin :: C a => a -> a
acos :: C a => a -> a
atan :: C a => a -> a
sinh :: C a => a -> a
cosh :: C a => a -> a
tanh :: C a => a -> a
asinh :: C a => a -> a
acosh :: C a => a -> a
atanh :: C a => a -> a
class (C a, C a, Ord a) => Real a where
abs :: a -> a
signum :: a -> a
class (Real a, C a) => RealIntegral a where
quot :: a -> a -> a
rem :: a -> a -> a
quotRem :: a -> a -> (a, a)
class (Real a, C a) => RealFrac a where
splitFraction :: ToInteger b => a -> (b, a)
fraction :: a -> a
ceiling :: ToInteger b => a -> b
floor :: ToInteger b => a -> b
truncate :: ToInteger b => a -> b
round :: ToInteger b => a -> b
atan2 :: C a => a -> a -> a
class Real a => ToRational a where
toRational :: a -> Rational
class (ToRational a, RealIntegral a) => ToInteger a where
toInteger :: a -> Integer
fromIntegral :: (ToInteger a, C b) => a -> b
reduceRepeated :: (a -> a -> a) -> a -> a -> Integer -> a
isUnit :: C a => a -> Bool
stdAssociate :: C a => a -> a
stdUnit :: C a => a -> a
stdUnitInv :: C a => a -> a
extendedGCD :: C a => a -> a -> (a, (a, a))
gcd :: C a => a -> a -> a
lcm :: C a => a -> a -> a
euclid :: (C a, C a) => (a -> a -> a) -> a -> a -> a
extendedEuclid :: (C a, C a) => (a -> a -> (a, a)) -> a -> a -> (a, (a, a))
type Rational = T Integer
(%) :: C a => a -> a -> T a
numerator :: T a -> a
denominator :: T a -> a
approxRational :: (ToRational a, RealFrac a) => a -> a -> Rational
toPRational :: (Integral a, C a) => T a -> Ratio a
Integer
Int
Float
Double
(*>) :: C a b => a -> b -> b
Documentation
(+) :: C a => a -> a -> a
add and subtract elements
(-) :: C a => a -> a -> a
negate :: C a => a -> a
inverse with respect to +
zero :: C a => a
zero element of the vector space
subtract :: C a => a -> a -> a
subtract is (-) with swapped operand order. This is the operand order which will be needed in most cases of partial application.
sum :: C a => [a] -> a
Sum up all elements of a list. An empty list yields zero.
sum1 :: C a => [a] -> a
Sum up all elements of a non-empty list. This avoids including a zero which is useful for types where no universal zero is available.
isZero :: C a => a -> Bool
(*) :: C a => a -> a -> a
one :: C a => a
fromInteger :: C a => Integer -> a
(^) :: C a => a -> Integer -> a

The exponent has fixed type Integer in order to avoid an arbitrarily limitted range of exponents, but to reduce the need for the compiler to guess the type (default type). In practice the exponent is most oftenly fixed, and is most oftenly 2. Fixed exponents can be optimized away and thus the expensive computation of Integers doesn't matter. The previous solution used a ToInteger constrained type and the exponent was converted to Integer before computation. So the current solution is not less efficient.

A variant of ^ with more flexibility is provided by ringPower.

ringPower :: (C a, ToInteger b) => b -> a -> a
sqr :: C a => a -> a
product :: C a => [a] -> a
product1 :: C a => [a] -> a
div :: C a => a -> a -> a
mod :: C a => a -> a -> a
divMod :: C a => a -> a -> (a, a)
divides :: (C a, C a) => a -> a -> Bool
even :: (C a, C a) => a -> Bool
odd :: (C a, C a) => a -> Bool
(/) :: C a => a -> a -> a
recip :: C a => a -> a
fromRational' :: C a => Rational -> a
(^-) :: C a => a -> Integer -> a
fieldPower :: (C a, ToInteger b) => b -> a -> a
fromRational :: C a => Rational -> a
(^/) :: C a => a -> Rational -> a
sqrt :: C a => a -> a
pi :: C a => a
exp :: C a => a -> a
log :: C a => a -> a
logBase :: C a => a -> a -> a
(**) :: C a => a -> a -> a
sin :: C a => a -> a
cos :: C a => a -> a
tan :: C a => a -> a
asin :: C a => a -> a
acos :: C a => a -> a
atan :: C a => a -> a
sinh :: C a => a -> a
cosh :: C a => a -> a
tanh :: C a => a -> a
asinh :: C a => a -> a
acosh :: C a => a -> a
atanh :: C a => a -> a
class (C a, C a, Ord a) => Real a where
Methods
abs :: a -> a
signum :: a -> a
show/hide Instances
Real Double
Real Float
Real Int
Real Integer
Real T
Real T
(Real a, C a) => Real (T a)
Real v => Real (T a v)
Real v => Real (T a v)
(Ord i, Real a) => Real (T i a)
class (Real a, C a) => RealIntegral a where
Methods
quot :: a -> a -> a
rem :: a -> a -> a
quotRem :: a -> a -> (a, a)
show/hide Instances
class (Real a, C a) => RealFrac a where
Methods
splitFraction :: ToInteger b => a -> (b, a)
fraction :: a -> a
ceiling :: ToInteger b => a -> b
floor :: ToInteger b => a -> b
truncate :: ToInteger b => a -> b
round :: ToInteger b => a -> b
show/hide Instances
atan2 :: C a => a -> a -> a
class Real a => ToRational a where
Methods
toRational :: a -> Rational
show/hide Instances
class (ToRational a, RealIntegral a) => ToInteger a where
Methods
toInteger :: a -> Integer
show/hide Instances
fromIntegral :: (ToInteger a, C b) => a -> b
reduceRepeated :: (a -> a -> a) -> a -> a -> Integer -> a

reduceRepeated is an auxiliary function that, for an associative operation op, computes the same value as

reduceRepeated op a0 a n = foldr op a0 (genericReplicate n a)

but applies op O(log n) times and works for large n.

isUnit :: C a => a -> Bool
stdAssociate :: C a => a -> a
stdUnit :: C a => a -> a
stdUnitInv :: C a => a -> a
extendedGCD :: C a => a -> a -> (a, (a, a))

Compute the greatest common divisor and solve a respective Diophantine equation.

   (g,(a,b)) = extendedGCD x y ==>
        g==a*x+b*y   &&  g == gcd x y

TODO: This method is not appropriate for the PID class, because there are rings like the one of the multivariate polynomials, where for all x and y greatest common divisors of x and y exist, but they cannot be represented as a linear combination of x and y. TODO: The definition of extendedGCD does not return the canonical associate.

gcd :: C a => a -> a -> a

The Greatest Common Divisor is defined by:

   gcd x y == gcd y x
   divides z x && divides z y ==> divides z (gcd x y)   (specification)
   divides (gcd x y) x
lcm :: C a => a -> a -> a
Least common multiple
euclid :: (C a, C a) => (a -> a -> a) -> a -> a -> a
extendedEuclid :: (C a, C a) => (a -> a -> (a, a)) -> a -> a -> (a, (a, a))
type Rational = T Integer
(%) :: C a => a -> a -> T a
numerator :: T a -> a
denominator :: T a -> a
approxRational :: (ToRational a, RealFrac a) => a -> a -> Rational
toPRational :: (Integral a, C a) => T a -> Ratio a
Integer
Int
Float
Double
(*>) :: C a b => a -> b -> b
scale a vector by a scalar
Produced by Haddock version 0.7