Folks,

Kent Karlsson has asked that we reconsider what integral division
and remainder functions we have in Haskell.  To do this right,
I think we need to consider the integral coercion ("rounding")
functions, as well.

To remind everyone of the background on this issue, there is
a basic problem with defining division on integers, which fundamentally
is a result of the fact that the integers with addition and multiplication
are not a division ring.  The various definitions of integer division
can be distinguished from one another by what rule is used to round
a non-integral rational quotient to an integral result.  These include
rounding towards zero, away from zero, towards minus infinity,
towards plus infinity, to the even integer, to the odd integer, to the
nearer integer, and as subcases of that last, all the other choices
again for rounding halves, making at least 12 choices in all.  If one
starts to enumerate desirable algebraic properties for integer division
(such as those that do hold in division rings) one finds that no single
choice of division function satisfies everything. (Otherwise, I suppose,
the integers would be a division ring after all.) Thus, the choice
is driven by which properties are needed for a given application.
For example, rounding toward zero or away from zero satisfy

        (-n) `div` d  ==  -(n `div` d)

and rounding to minus or plus infinity satisfy

        (n + k*d) `div` d  ==  n `div` d  +  k

Given a division function, a remainder function rem is a solution to

        n `div` d * d + n `rem` d  =  n

Desirable properties of remainders can be enumerated, as well.

[My purpose inn laying out the above is not to re-ignite the flames,
but just to remind everyone of the background.]

Now, the current division, remainder, and rounding functions
in Haskell are the following:

div, rem, mod                   :: (Integral a) => a -> a -> a
divRem                          :: (Integral a) => a -> a -> (a,a)
truncate, floor, ceiling, round :: (RealFrac a, Integral b) => a -> b

div is division with rounding toward zero, and rem is its remainder.
mod is the remainder from division with rounding toward minus infinity.
truncate, floor, ceiling, and round are rounding toward zero, toward
minus infinity, toward plus infinity, and to nearest with the half
going to even, respectively.  This collection of functions is not
arbitrary; there is the following correspondence with Scheme:

        div             quotient
        rem             remainder
        mod             modulo
        truncate        truncate
        floor           floor
        ceiling         ceiling
        round           round

Perhaps this choice of functions by the Scheme designers is a bit odd,
though.  Why is there no division function whose remainder is `modulo'?
Why are there neither division nor remainder functions corresponding
to `ceiling' or `round'?

In a previous message on this subject in the dim past, I think I said
that the above functions are also those of Common Lisp.  That was
incorrect.  Common Lisp, in its typeless splendor, defines the following
procedures of one or two arguments, each producing two results,
the second of which is often ignored:

        truncate
        floor
        ceiling
        round

When applied to one argument, the first result of each of the above
is the same as the result of the Scheme function of the same name;
the second result is the remainder from the rounding (of the same
type as the argument).  When applied two arguments, these procedures
perform a division with the specified rounding and return a quotient
and remainder.  The one-argument case essentially amounts to a default
of 1 being supplied for the second argument.  In addition, the following
functions of two arguments are defined:

        mod
        rem

These are the second results of `floor' and `truncate', respectively.
(`truncate' with two arguments and ignoring the second result
is the equivalent of Scheme `quotient'.)

The last time the matter of these functions in Haskell was discussed,
I don't believe we had added default methods to the language, and
thus, there was more concern about unnecessary bloating of the standard
classes.  Now that we have default methods, however, there is a
way to get compatibility with both Scheme and Common Lisp (and in
the process satisfy Kent and others who have called for a division-
with-floor function) at little cost:

Proposal
^^^^^^^^

Redefine the Integral and RealFrac classes:

class  (Real a, Ix a) => Integral a  where
    div, rem, mod       :: a -> a -> a
    divTruncateRem      :: a -> a -> (a,a)
    divFloorRem         :: a -> a -> (a,a)
    divCeilingRem       :: a -> a -> (a,a)
    divRoundRem         :: a -> a -> (a,a)
    even, odd           :: a -> Bool
    toInteger           :: a -> Integer

    n `div` d           =  fst (divTruncateRem n d)
    n `rem` d           =  snd (divTruncateRem n d)
    n `mod` d           =  snd (divFloorRem n d)

    divFloorRem n d     =  if r < 0 then (q-1, r+d) else qr
                           where qr@(q,r) = divTruncateRem n d

    divCeilingRem n d   =  if r > 0 then (q+1, r-d) else qr
                           where qr@(q,r) = divTruncateRem n d

    divRoundRem n d     =  case signum (abs r - 0.5) of
                                -1  ->  qr
                                0   ->  if even q then qr else qr'
                                1   ->  qr'
                           where qr@(q,r) = divTruncateRem n d
                                 qr' = if r < 0 then (q-1, r+d) else (q+1, r-d)

    even n              =  n `rem` 2 == 0
    odd                 =  not . even

class  (Real a, Fractional a) => RealFrac a  where
    truncateRem         :: (Integral b) => a -> (b,a)
    floorRem            :: (Integral b) => a -> (b,a)
    ceilingRem          :: (Integral b) => a -> (b,a)
    roundRem            :: (Integral b) => a -> (b,a)
    approxRational      :: a -> a -> Rational

    floorRem x          =  if r < 0 then (n+1, r-1) else nr
                           where nr@(n,r) = truncateRem x

    ceilingRem x        =  if r > 0 then (n-1, r+1) else nr
                           where nr@(n,r) = truncateRem x

    RoundRem x          =  case signum (abs r - 0.5) of
                                -1  ->  nr
                                0   ->  if even n then nr else nr'
                                1   ->  nr'
                           where nr@(n,r) = TruncateRem n d
                                 nr' = if r < 0 then (n-1, r+1) else (n+1, r-1)

Delete the current truncate, floor, ceiling, and round function definitions
from Prelude.hs and add the following:

divRem                  =  divTruncateRem
properFraction          =  TruncateRem

truncate, floor, ceiling, round :: (RealFrac a, Integral b) => a -> b
truncate                =  fst . truncateRem
floor                   =  fst . floorRem
ceiling                 =  fst . ceilingRem
round                   =  fst . roundRem


--Joe

Reply via email to