Revisiting the Numeric Classes ------------------------------ The Prelude for Haskell 98 offers a well-considered set of numeric classes which cover the standard numeric types (Integer, Int, Rational, Float, Double, Complex) quite well. But they offer limited extensibility and have a few other flaws. In this proposal we will revisit these classes, addressing the following concerns: (1) The current Prelude defines no semantics for the fundamental operations. For instance, presumably addition should be associative (or come as close as feasible), but this is not mentioned anywhere. (2) There are some superfluous superclasses. For instance, Eq and Show are superclasses of Num. Consider the data type > data IntegerFunction a = IF (a -> Integer) One can reasonably define all the methods of Num for IntegerFunction a (satisfying good semantics), but it is impossible to define non-bottom instances of Eq and Show. In general, superclass relationship should indicate some semantic connection between the two classes. (3) In a few cases, there is a mix of semantic operations and representation-specific operations. toInteger, toRational, and the various operations in RealFloating (decodeFloat, ...) are the main examples. (4) In some cases, the hierarchy is not finely-grained enough: operations that are often defined independently are lumped together. For instance, in a financial application one might want a type "Dollar", or in a graphics application one might want a type "Vector". It is reasonable to add two Vectors or Dollars, but not, in general, reasonable to multiply them. But the programmer is currently forced to define a method for (*) when she defines a method for (+). In specifying the semantics of type classes, I will state laws as follows: (a + b) + c === a + (b + c) The intended meaning is extensional equality: the rest of the program should behave in the same way if one side is replaced with the other. Unfortunately, the laws are frequently violated by standard instances; the law above, for instance, fails for Float: (100000000000000000000.0 + (-100000000000000000000.0)) + 1.0 = 1.0 100000000000000000000.0 + ((-100000000000000000000.0) + 1.0) = 0.0 Thus these laws should be interpreted as guidelines rather than absolute rules. In particular, the compiler is not allowed to use them. Unless stated otherwise, default definitions should also be taken as laws. This version is fairly conservative. I have retained the names for classes with similar functions as far as possible, I have not made some distinctions that could reasonably be made, and I have tried to opt for simplicity over generality. The main non-conservative change is the Powerful class, which allows a unification of the Haskell 98 operators (^), (^^), and (**). There are some problems with it, but I left it in because it might be of interest. It is very easy to change back to the Haskell 98 situation. I sometimes use Simon Peyton Jones' pattern guards in writing functions. This can (as always) be transformed into Haskell 98 syntax. > module NumPrelude where > import qualified Prelude as P > -- Import some standard Prelude types verbatim verbandum > import Prelude(Bool(..),Maybe(..),Eq(..),Either(..),Ordering(..), > Ord(..),Show(..),Read(..),id) > > infixr 8 ^ > infixl 7 * > infixl 7 /, `quot`, `rem`, `div`, `mod` > infixl 6 +, - > > class Additive a where > (+), (-) :: a -> a -> a > negate :: a -> a > zero :: a > > -- Minimal definition: (+), zero, and (negate or (-1)) > negate a = zero - a > a - b = a + (negate b) Additive a encapsulates the notion of a commutative group, specified by the following laws: a + b === b + a (a + b) + c) === a + (b + c) zero + a === a a + (negate a) === 0 Typical examples include integers, dollars, and vectors. > class (Additive a) => Num a where > (*) :: a -> a -> a > one :: a > fromInteger :: Integer -> a > > -- Minimal definition: (*), one > fromInteger 0 = zero > fromInteger n | n < 0 = negate (fromInteger (-n)) > fromInteger n | n > 0 = reduceRepeat (+) one n Num encapsulates the mathematical structure of a (not necessarily commutative) ring, with the laws a * (b * c) === (a * b) * c one * a === a a * one === a a * (b + c) === a * b + a * c Typical examples include integers, matrices, and quaternions. "reduceRepeat op a n" is an auxiliary function that, for an associative operation "op", computes the same value as reduceRepeat op a n = foldr1 op (repeat n a) but applies "op" O(log n) times. A sample implementation is below. > class (Num a) => Integral a where > div, mod :: a -> a -> a > divMod :: a -> a -> (a,a) > gcd, lcm :: a -> a -> a > extendedGCD :: a -> a -> (a,a,a) > > -- Minimal definition: divMod or (div and mod) > -- and extendedGCD, if the provided definition does not work > div a b | (d,_) <- divMod a b = d > mod a b | (_,m) <- divMod a b = m > divMod a b = (div a b, mod a b) > gcd a b | (_,_,g) <- extendedGCD a b = g > extendedGCD a b = ... -- insert Euclid's algorithm here > lcm a b = (a `div` gcd a b) * b Integral has the mathematical structure of a unique factorization domain, satisfying the laws a * b === b * a (div a b) * b + (mod a b) === a mod (a+k*b) b === mod a b a `div` gcd a b === zero gcd a b === gcd b a gcd (a + k*b) b === gcd a b a*c + b*d === g where (c, d, g) = extendedGCD a b TODO: quot, rem partially defined. Explain. The default definition of extendedGCD above should not be taken as canonical (unlike most default definitions); for some Integral instances, the algorithm could diverge, might not satisfy the laws above, etc. Typical examples of Integral include integers and polynomials over a field. Note that, unlike in Haskell 98, gcd and lcm are member function of Integral. extendedGCD is new. > class (Num a) => Fractional a where > (/) :: a -> a -> a > recip :: a -> a > fromRational :: Rational -> a > > -- Minimal definition: recip or (/) > recip a = one / a > a / b = a * (recip b) > fromRational r = fromInteger (numerator r) / fromInteger (denominator r) Fractional encapsulates the mathematical structure of a field, satisfying the laws a * b === b * a a * (recip a) === one TODO: (/) is only partially defined. How to specify? Add a member isInvertible :: a -> Bool? Typical examples include rationals, the real numbers, and rational functions (ratios of polynomials). > class (Num a, Additive b) => Powerful a b where > (^) :: a -> b -> a > instance (Num a) => Powerful a (Positive Integer) where > a ^ 0 = one > a ^ n = reduceRepeated (*) a n > instance (Fractional a) => Powerful a Integer where > a ^ n | n < 0 = recip (a ^ (negate n)) > a ^ n = a ^ (positive n) Powerful is the class of pairs of numbers which can be exponentiated, with the following laws: (a ^ b) * (a ^ c) === a ^ (b + c) a ^ one === a I don't know interesting examples of this structure besides the instances above defined above and the Floating class below. "Positive" is a type constructor that asserts that its argument is >= 0; "positive" makes this assertion. I am not sure how this will interact with defaulting arguments so that one can write x ^ 5 without constraining x to be of Fractional type. > -- Note: I think "Analytic" would be a better name than "Floating". > class (Fractional a, Powerful a a) => Floating a where > pi :: a > exp, log, sqrt :: a -> a > logBase :: a -> a -> a > sin, cos, tan :: a -> a > asin, acos, atan :: a -> a > sinh, cosh, tanh :: a -> a > asinh, acosh, atanh :: a -> a > > -- Minimal complete definition: > -- pi, exp, log, sin, cos, sinh, cosh > -- asinh, acosh, atanh > x ^ y = exp (log x * y) > logBase x y = log y / log x > sqrt x = x ^ 0.5 > tan x = sin x / cos x > tanh x = sinh x / cosh x Floating is the type of numbers supporting various analytic functions. Examples include real numbers, complex numbers, and computable reals represented as a lazy list of rational approximations. Note the default declaration for a superclass. See the comments below, under "Instance declaractions for superclasses". The semantics of these operations are rather ill-defined because of branch cuts, etc. > class (Num a, Ord a) => Real a where > abs :: x -> x > signum :: x -> x > > -- Minimal definition: nothing > abs x = max x (negate x) > signum x = case compare x zero of GT -> one > EQ -> zero > LT -> negate one This is the type of an ordered ring, satisfying the laws a * b === b * a a + (max b c) === max (a+b) (a+c) negate (max b c) === min (negate b) (negate c) a * (max b c) === max (a*b) (a*c) where a >= 0 Note that abs is in a rather different place than it is in the Haskell 98 Prelude. In particular, abs :: Complex -> Complex is not defined. To me, this seems to have the wrong type anyway; Complex.magnitude has the correct type. > class (Real a, Floating a) => RealFrac a where > -- lifted directly from Haskell 98 Prelude > properFraction :: (Integral b) => a -> (b,a) > truncate, round :: (Integral b) => a -> b > ceiling, floor :: (Integral b) => a -> b > > -- Minimal complete definition: > -- properFraction > truncate x = m where (m,_) = properFraction x > > round x = let (n,r) = properFraction x > m = if r < 0 then n - 1 else n + 1 > in case signum (abs r - 0.5) of > -1 -> n > 0 -> if even n then n else m > 1 -> m > > ceiling x = if r > 0 then n + 1 else n > where (n,r) = properFraction x > > floor x = if r < 0 then n - 1 else n > where (n,r) = properFraction x As an aside, let me note the similarities between "properFraction x" and "x divMod 1" (if that were defined.) > class (RealFrac a, Floating a) => RealFloat a where > atan2 :: a -> a -> a > atan2 y x > | x>0 = atan (y/x) > | x==0 && y>0 = pi/2 > | x<0 && y>0 = pi + atan (y/x) > |(x<=0 && y<0) || > (x<0 && isNegativeZero y) || > (isNegativeZero x && isNegativeZero y) > = -atan2 (-y) x > | y==0 && (x<0 || isNegativeZero x) > = pi -- must be after the previous test on zero y > | x==0 && y==0 = y -- must be after the other double zero tests > | otherwise = x + y -- x or y is a NaN, return a NaN (via +) > > class (Real a, Integral a) => RealIntegral a where > quot, rem :: a -> a -> a > quotRem :: a -> a -> (a,a) > > -- Minimal definition: toInteger > -- insert quot, rem, quotRem definition here > > --- Numerical functions > subtract :: (Additive a) => a -> a -> a > subtract = flip (-) > > even, odd :: (Integral a) => a -> Bool > even n = n `div` 2 == 0 > odd = not . even Additional standard libraries would include IEEEFloat (including the bulk of the functions in Haskell 98's RealFloat class), VectorSpace, Ratio, and Lattice. Let me explain that last one. ----- > module Lattice where > class Lattice a where > meet, join :: a -> a -> a Mathematically, a lattice (more properly, a semilattice) is a space with operations "meet" and "join" which are idempotent, commutative, associative, and (usually) distribute over each other. Examples include real-valued function with (pointwise) max and min and sets with union and intersection. It would be reasonable to make Ord a subclass of this, but it would probably complicate the class heirarchy too much for the gain. The advantage of Lattice over Ord is that it is better defined. Thus we can define a class > class (Lattice a, Num a) => NumLattice a where > abs :: a -> a -> a > abs x = meet x (negate x) and real-valued functions and computable reals can both be declared as instances of this class.