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

Creating a custom Rational class in Common Lisp – Part 1

In this series of blog posts, I will attempt at creating a rudimentary (but complete) Rational Number package in Common Lisp. A rational number is simply a number of the form a/b, where a and b have been reduced to their lowest forms, and b is not 0. The first step is to define a class that will represent rational numbers. For this purpose, I will liberally take inspiration from Martin Odersky’s Rational class implementation in his introductory book on Scala. Thereafter, all the basic numerical operations will be supported – addition, subtraction, multiplication, and division, not only between rational numbers, but also between integers and rational numbers.

In this first part, I will create a ‘my-rational’ class that will represent rational numbers. To this end, the draft code for this class is as shown below:

;;;; 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 changed to 1.

(defpackage #:my-rationals
  (:use #:common-lisp)
  (:export #:my-rational))

(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
;;; all of which extend my-rational-base-error
(defmacro gen-error (subtype basetype read-func)
  (let ((c (gensym))
        (s (gensym)))
  `(define-condition ,subtype (,basetype) ()
     (:report (lambda (,c ,s)
                (format ,s "~a~%" (,read-func ,c)))))))

(gen-error numerator-not-a-number my-rational-base-error error-message)
(gen-error denominator-not-a-number my-rational-base-error error-message)
(gen-error denominator-not-specified my-rational-base-error error-message)
(gen-error denominator-zero my-rational-base-error error-message)

;;; 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 :initform 1)))

(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
(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)
  (print-unreadable-object (obj stream :type t :identity t)
    (with-slots ((num numerator) (denom denominator)) obj
      (format stream "~d/~d" num denom))))

Explanatory notes: The code is pretty straightforward. First, we define some potential error conditions that we might be interested in. To save on writing out repetitive code for all the error conditions, we define a macro (GEN-ERROR) to generate the same. This is especially useful since most of the code in those error classes (were they to be written by hand) would basically contain code to display the error message in the Common Lisp debugger (using :report) such as, for instance:

(define-condition 'numerator-not-a-number (my-rational-base-error) ()
  (:report (lambda (condition stream)
             (format stream "~a~%" (error-message condition))))

Then we define the class itself. Currently, it just contains two slots (fields in OOP parlance) – numerator and denominator. The INITIALIZE-INSTANCE generic method simply runs code after an object has been created (but before it is returned to the client). This is done using the :after specification in the definition of this method. Conveniently, we place the validation code inside this function. The validation code simply uses a simple RESTART-CASE macro to define restart cases for potential error conditions. Note that this also essentially means that this code is meant to be used either in an interactive manner, or with a client that has the relevant higher-level error handling strategies defined (say, using a HANDLER-BIND to bind all the aforementioned error conditions. For more details, check the earlier blogpost on Conditions and Restarts in Common Lisp).

Note that we also include logic to reduce the numerator and denominator to their lowest terms by using their GCD. A point to be noted here is that we would like the denominator to default to 1 even without any user entry, but that is not supported in this version. In a future version, the denominator could probably be made optional, and relevant changes made to other supporting code to ensure that the denominator defaults to 1. This would also preclude the need for the make-denominator-one restart case.

So this current version supports basic value assertions, reduces valid rational numbers to their lowest forms, and has the ability to pretty-print the instances of this class. This pretty printing method is pretty much standard for custom classes created using CLOS. We simply implement the generic method, PRINT-OBJECT, which in term uses PRINT-UNREADABLE-OBJECT to handle the display of the object’s class’ slots.

Finally note that the whole class is packaged in its own custom #:MY-RATIONALS package so as to avoid any conflict with other packages.

In the next few blog posts, the following changes are planned for this class:

    • Make the denominator optional and provide a default value of 1 (the current :initform is practically useless).
    • Include generic functions for addition, subtraction, multiplication, and division of rationals.
    • Implement the generic functions using generic methods for the my-rational class.
    • Implement support for rational classes with integers.
    • Extend error handling to check for valid non-rational arguments (restrict to integers).

Till next time!

Creating a custom Rational class in Common Lisp – Part 1