Creating a custom Rational class in Common Lisp – Part 3 (Conclusion)


This is the concluding part of this small project to create a Rationals class/package in Common Lisp. After much deliberation, I decided to end the project at this stage for the following reasons:

  • All the functionality that I had wanted to include have been included.
  • Error conditions have been moved to their own package which is now used by the main package.
  • Error handling is done as best could be for the moment – highly interactive, but since this is a library, error handling code on the client side should have proper HANDLER-BINDs in any case (if they are non-interactive clients), otherwise the current scheme will still throw the same errors that they would have to handle anyway.
  • I decided to forego the implementation of a macro (probably an anaphoric macro at that) to reduce the common boilerplate code that the various generic methods had. I found out that introducing a new anaphoric macro such as the following:
    (defmacro with-anaphoric-accessors ((first second) &body body)
      `(with-accessors ((num-one rational-numerator)
                        (denom-one rational-denominator)) ,first
         (with-accessors ((num-two rational-numerator)
                          (denom-two rational-denominator)) ,second
           ,@body)))
    

    would have had disadvantages far outweighing the potential advantages, especially in terms of readability of the code.

  • Finally, without proper understanding of the de-factor Common Lisp project manager library, ASDF, I realised that this code had been packaged as well as it could have been. The next step is to learn ASDF (and Quicklisp) in detail so that I can produce better packaged code. The default Common Lisp packaging system just does not cut it beyond a certain level of complexity as I’ve learnt.The final version of the code is broken into two packages – the #:my-rationals-errors package contains the error conditions (and must be compiled first), and the #:my-rationals package contains the rest of the code. All the functionality that I had set out to include has been included.

The #:my-rationals-errors package:

;;;; error conditions for the Rational number package.

(defpackage #:my-rationals-errors
  (:use #:common-lisp)
  (:export #:numerator-not-a-number
           #:denominator-not-a-number
           #:denominator-not-specified
           #:denominator-zero))

(in-package #:my-rationals-errors)

;;;
;;; Define some error conditions that could arise
;;; when instantiating Rationals.
;;;

(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-specified (my-rational-base-error)
  (with-reporting))

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

And, of course, the #:my-rationals package:

;;;; 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 #:my-rationals-errors)
  (:export #:my-rational
           #:add
           #:subtract
           #:multiply
           #:divide))

(in-package #:my-rationals)

;;;
;;; 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))))

I do apologise for the less-than-deal indentation in the code pasted here. WordPress apparently does not believe in respecting the 80-column width rule, not does it believe in providing people with the option to reduce the font size even in “Visual Mode” (at least so far as I am able to tell). On that note, I can’t, for the life of me, understand why WordPress has to mess up special characters and insert HTML character entities with gay abandon. Woe to anyone who dares edit a post!

Next up should be a series of blogs sharing my learnings of ASDF, Quicklisp, and a few small projects to practise those concepts. In case some of the projects grow to a considerable size, I might put them up on GitHub (or some such site) and post the link here, but I will ensure that I highlight the salient points of learning from those projects in this blog itself.

Advertisements
Creating a custom Rational class in Common Lisp – Part 3 (Conclusion)

Speak your mind!

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s