ARNESI

Decimal Arithmetic 

Converting to and from external representations

(defvar *precision* 2
  "Default precision.")

(defmacro with-precision (prec &body body)
  "Evalute BODY with *precision* bound to @var{prec}."
  (let ((precision (gensym)))
    `(let ((,precision ,prec))
       (assert (integerp ,precision)
	       (,precision)
	       "Precision must be an integer, not ~S" ,precision)
       (let ((*precision* (10^ ,precision)))
	 (declare (special *precision*))
	 ,@body))))

(defun decimal-from-float (float
                           &optional (precision *precision*)
                                     (rounding-method #'round-half-up))
  "Convert @var{float} to an exact value with precision
  @var{precision} using @var{rounding-method} to do any
  neccessary rounding."
  (funcall rounding-method float precision))

(defun float-from-decimal (decimal)
  "Convert the exact decimal value @var{decimal} to a (not
  neccassily equal) floating point value."
  (float decimal))

Rounding functions

(defun round-down (number &optional (precision *precision*))
  "Round towards 0."
  (if (minusp number)
      (round-ceiling number precision)
      (round-floor   number precision)))

(defun round-half-up (number &optional (precision *precision*))
  "Round towards the nearest value allowed with the current
precision. If the current value is exactly halfway between two logal
values round away from 0."
  (multiple-value-bind (value discarded)
      (floor (* number precision))
    (if (<= 1/2 discarded)
	(/ (1+ value) precision)
        (/ value precision))))

(defun round-half-even (number &optional (precision *precision*))
  "Round towards the nearest value allowed with the current
precision. If the current value is exactly halfway between two legal
values round towards the nearest even value."
  (multiple-value-bind (value discarded)
      (floor (* number precision))
    (cond
     ((< discarded 1/2) ;; down
      (/ value precision))
     ((= discarded 1/2) ;; goto even
      (if (evenp value)
	  (/ value precision)
	  (/ (1+ value) precision)))
     (t ;; (>= discarded 1/2)
      (/ (1+ value) precision)))))

(defun round-ceiling (number &optional (precision *precision*))
  "Round towards positive infintity"
  (/ (ceiling (* number precision)) precision))

(defun round-floor (number &optional (precision *precision*))
  "Round towards negative infinity."
  (/ (floor (* number precision)) precision))

(defun round-half-down (number &optional (precision *precision*))
  "Round towards the nearest legal value. If the current value is
exactly half way between two legal values round towards 0."
  (multiple-value-bind (value discarded)
      (floor number)
    (if (< 1/2 discarded)
	(/ (1+ value) precision)
        (/ value precision))))

(defun round-up (number &optional (precision *precision*))
  "Round away from 0."
  (if (minusp number)
      (round-floor number precision)
      (round-ceiling number precision)))