Creating a custom Rational class in Common Lisp – Part 2

In the previous post, we saw a basic Rational class that handled instantiation of its instances by taking care of the appropriate error cases. In this post, we will extend the class further by taking care of some of the improvements that were planned out at the end of the previous post. Some of the improvements made are:

  • Implementation of addition, subtraction, multiplication, and division not only between rational numbers but also with integers.
  • A better macro, WITH-REPORTING, that takes care of the repetitive bits of the error conditions without reducing readability.
  • Changed the use of WITH-SLOTS to WITH-ACCESSORS (and therefore changed the :reader in the my-rational class definition to :accessor. This is perfectly fine since we need to allow the client to modify an existing instance of the rational object.
  • Despite allowing mutations directly in instances of the my-rational class, all the arithmetic functions are essentially purely-functional – they simply create a new instance of my-rational with the newly calculated parameters.

The code thus far looks like this:

;;;; A sample implementation inspired by Martin Odersky's class in his
;;; introduction to Scala.

;;; A rational number is a number that is of the form a/b where a and b
;;; are numbers, are in their lowest normalized forms, and therefore
;;; cannot be reduced further. If a/b is an integer, b is
;;; represented by 1.

(defpackage #:my-rationals
  (:use #:common-lisp)
  (:export #:my-rational
           #:add
           #:subtract
           #:multiply
           #:divide))

(in-package #:my-rationals)

;;;
;;; Define some error conditions that could arise
;;;

(define-condition my-rational-base-error (error)
  ((message :initarg :message :reader error-message)))

;;; Macro to generate different error conditions
(defmacro with-reporting ()
  (let ((condition (gensym))
        (stream (gensym)))
    `(:report (lambda (,condition ,stream)
                (format ,stream "~a~%" (error-message ,condition))))))

(define-condition numerator-not-a-number (my-rational-base-error)
  (with-reporting))

(define-condition denominator-not-a-number (my-rational-base-error)
  (with-reporting))

(define-condition denominator-not-specifiedd (my-rational-base-error)
  (with-reporting))

(define-condition denominator-zero (my-rational-base-error)
  (with-reporting))

;;;
;;; Define the Rational class
;;;

(defclass my-rational ()
  ((numerator :initarg :numerator :accessor rational-numerator
              :initform (error "Numerator required for a rational number"))
   (denominator :initarg :denominator :accessor rational-denominator)))

(defun check-param-values (n d)
  (cond
    ((not (realp n))
     (error 'numerator-not-a-number :message "Numerator is not a valid number"))
    ((null d)
     (error 'denominator-not-specified :message "Denominator is not provided"))
    ((not (realp d))
     (error 'denominator-not-a-number :message "Denominator is not a valid number"))
    ((zerop d)
     (error 'denominator-zero :message "Denominator is zero!"))))

(defun validate-params (obj)
  (with-accessors ((num rational-numerator) (denom rational-denominator)) obj
    (restart-case (check-param-values num denom)
      (enter-new-numerator (n)
        :report "Supply a new value for the numerator"
        :interactive (lambda ()
                       (get-new-value 'numerator))
        (setf num n)
        (validate-params obj))
      (enter-new-denominator (d)
        :report "Supply a new value of denominator"
        :interactive (lambda ()
                       (get-new-value 'denominator))
        (setf denom d)
        (validate-params obj))
      (make-denominator-one ()
        :report "Force the denominator to be 1"
        (setf denom 1)
        (validate-params obj)))))

;;; some helper functions for validation
(defun get-new-value (param)
  (format *query-io* "Enter new value for ~s: " param)
  (force-output *query-io*)
  (list (read *query-io*)))

(defun my-gcd (x y)
  (if (zerop y)
      x
      (my-gcd y (mod x y))))

(defmethod initialize-instance :after ((obj my-rational) &key)
  (validate-params obj)
  (with-accessors ((num rational-numerator) (denom rational-denominator)) obj
    (let ((g (my-gcd num denom)))
      (setf num (floor (/ num g))
            denom (floor (/ denom g))))))

;;; custom object printing
(defmethod print-object ((obj my-rational) stream)
  (with-accessors ((num rational-numerator) (denom rational-denominator)) obj
    (print-unreadable-object (obj stream :type t :identity t)
      (format stream "~d/~d" num denom))))

;;;
;;; Arithmetic operations - generic functions
;;;
(defgeneric add (first second)
  (:documentation "Add two rational numbers together"))

(defgeneric add (first int)
  (:documentation "Add a rational number to an integer"))

(defgeneric add (int second)
  (:documentation "Add an integer to a rational number"))

(defgeneric subtract (first second)
  (:documentation "Subtract the second rational number from the first"))

(defgeneric subtract (first int)
  (:documentation "Subtract an integer from a rational number"))

(defgeneric subtract (int second)
  (:documentation "Subtract a rational number from an integer"))

(defgeneric multiply (first second)
  (:documentation "Multiply two rational numbers together"))

(defgeneric multiply (first int)
  (:documentation "Multiply a rational number with an integer"))

(defgeneric multiply (int second)
  (:documentation "Multiply an integer with a rational number"))

(defgeneric divide (first second)
  (:documentation "Divide the first rational number by the second"))

(defgeneric divide (first int)
  (:documentation "Divide a rational number by an integer"))

(defgeneric divide (int second)
  (:documentation "Divide an integer by a rational number"))

;;; Arithmetic operations - generic methods

(defmethod add ((first my-rational) (second my-rational))
  (with-accessors ((num-one rational-numerator) (denom-one rational-denominator)) first
    (with-accessors ((num-two rational-numerator) (denom-two rational-denominator)) second
      (let ((d (* denom-one denom-two))
            (n (+ (* num-one denom-two)
                  (* denom-one num-two))))
        (make-instance 'my-rational :numerator n :denominator d)))))

(defmethod add ((first my-rational) (int integer))
  (with-accessors ((num rational-numerator) (denom rational-denominator)) first
    (let ((n (+ num (* denom int))))
      (make-instance 'my-rational :numerator n :denominator denom))))

(defmethod add ((int integer) (second my-rational))
  (add second int))

(defmethod subtract ((first my-rational) (second my-rational))
  (with-accessors ((num-one rational-numerator) (denom-one rational-denominator)) first
    (with-accessors ((num-two rational-numerator) (denom-two rational-denominator)) second
      (let ((d (* denom-one denom-two))
            (n (- (* num-one denom-two)
                  (* denom-one num-two))))
        (make-instance 'my-rational :numerator n :denominator d)))))

(defmethod subtract ((first my-rational) (int integer))
  (with-accessors ((num rational-numerator) (denom rational-denominator)) first
    (let ((n (- num (* denom int))))
      (make-instance 'my-rational :numerator n :denominator denom))))

(defmethod subtract ((int integer) (second my-rational))
  (with-accessors ((num rational-numerator) (denom rational-denominator)) second
    (let ((n (- (* int denom) num)))
      (make-instance 'my-rational :numerator n :denominator denom))))

(defmethod multiply ((first my-rational) (second my-rational))
  (with-accessors ((num-one rational-numerator) (denom-one rational-numerator)) first
    (with-accessors ((num-two rational-numerator) (denom-two rational-numerator)) second
      (let ((d (* denom-one denom-two))
            (n (* num-one num-two)))
        (make-instance 'my-rational :numerator n :denominator d)))))

(defmethod multiply ((first my-rational) (int integer))
  (with-accessors ((num rational-numerator) (denom rational-denominator)) first
    (let ((n (* num int)))
      (make-instance 'my-rational :numerator n :denominator denom))))

(defmethod multiply ((int integer) (second my-rational))
  (multiply second int))

(defmethod divide ((first my-rational) (second my-rational))
  (with-accessors ((num-one rational-numerator) (denom-one rational-denominator)) first
    (with-accessors ((num-two rational-numerator) (denom-two rational-denominator)) second
      (let ((d (* denom-one num-two))
            (n (* num-one denom-two)))
        (make-instance 'my-rational :numerator n :denominator d)))))

(defmethod divide ((first my-rational) (int integer))
  (with-accessors ((num rational-numerator) (denom rational-denominator)) first
    (let ((d (* denom int)))
      (make-instance 'my-rational :numerator num :denominator d))))

(defmethod divide ((int integer) (second my-rational))
  (with-accessors ((num rational-numerator) (denom rational-denominator)) second
    (let ((n (* int denom))
          (d num))
      (make-instance 'my-rational :numerator n :denominator d))))

Next steps:

  • I don’t particularly like the repetitive code in the generic methods. The WITH-ACCESSORS pattern could probably be abstracted out using a macro. This bears investigating.
  • The error conditions could probably go into a separate package that is then used by the #:my-rationals package. This might lead to cleaner-looking code.
  • Finally, and most importantly, I need to see how to best provide all my-rational class instantiating checks to non-interactive clients. For those clients, invoking restarts that expect a manual entry of input is meaningless. ASSERTs might be the way to go for them with basic restart strategy handling using HANDLER-BIND, the onus for which is completely on the client.

Well, that’s all for next time!

Creating a custom Rational class in Common Lisp – Part 2