Subject: Re: request for people to comment on my code
From: Erik Naggum <erik@naggum.net>
Date: Thu, 27 Dec 2001 16:35:14 GMT
Newsgroups: comp.lang.lisp
Message-ID: <3218459711177424@naggum.net>

* Marc Spitzer
| I am trying to get back to learning lisp, so I got out my copy of object
| oriented common lisp and set to work on exercise 4.7.2, making sure a
| list contains a valid roman numeral.

  I think this exercise shows that it was a bad idea to recurse only on the
  elements/characters of the roman numeral.  You also need to recurse on
  the valid units and units-and-a-half (or half-units, depending on how you
  look at them).  If you use old-style roman numerals (format control
  ~:@R), there is one valid pattern: an optional unit-and-a-half followed
  by no more than four units, but new-style (format control ~@R) is more
  complex: one unit digit may be followed by the next larger unit or the
  unit-and-a-half where old-style would have used four units.  (That is, in
  the old style, you need no look-ahead, but in new style, you need two: in
  the number being parsed and in the list of units.  Note that the largest
  number representable in the old style is 4999, while the new style gives
  up 3999, although many believe that a bar over the letters were used to
  multiply it by 1000, making the largest numbers 4,999,999, and 3,999,999,
  respectively, but such a bar is unavailable unless one wants to use
  Unicode combining diacritics.  Anyway, the history of this practice is
  blurry and there are records of alternatives that used more letters than
  MCXI for units and DLV for half-units, but they seem to have failed to
  agree on the letters used.)

  Anyway, since I have only skimmed the book, but think it has so far done
  the reader a disservice by being very Schemish, both in naming the
  function "roman-to-decimal" (as opposed to "roman-to-hexadecimal"?) and
  in using recursion in the wrong way, I have toyed with an evil Scheme-
  like solution to the problem.  The function parse-failure could be
  replaced by exploiting call-with-current-continuation, too.  :)

(in-package :cl-user)

(defun parse-roman-digit-sequence (count roman start end digit unit half cont fail)
  (cond ((< count 0) (funcall fail nil))
	((= start end) 0)
	((equalp (char roman start) (second unit))
	 (+ (first digit)
	    (parse-roman-digit-sequence
	     (1- count) roman (1+ start) end digit unit half cont fail)))
	(t (funcall cont roman start end (cdr digit) (cdr unit) (cdr half) fail))))

(defun parse-old-roman-digit (roman start end digit unit half fail)
  (cond ((= start end) 0)
	((null digit) (funcall fail nil))
	((equalp (char roman start) (first half))
	 (+ (* (first digit) 5)
	    (parse-old-roman-digit
	     roman (1+ start) end digit unit (cons nil (cdr half)) fail)))
	(t (parse-roman-digit-sequence
            4 roman start end digit unit half #'parse-old-roman-digit fail))))

(defun parse-new-roman-digit (roman start end digit unit half fail)
  (cond ((= start end) 0)
	((null digit) (funcall fail nil))
	((and (< (1+ start) end)
	      (equalp (char roman start) (second unit))
	      (equalp (char roman (1+ start)) (first unit)))
	 (+ (* (first digit) 9)
	    (parse-new-roman-digit
	     roman (+ 2 start) end (cdr digit) (cdr unit) (cdr half) fail)))
	((and (< (1+ start) end)
	      (equalp (char roman start) (second unit))
	      (equalp (char roman (1+ start)) (first half)))
	 (+ (* (first digit) 4)
	    (parse-new-roman-digit
	     roman (+ 2 start) end (cdr digit) (cdr unit) (cdr half) fail)))
	((equalp (char roman start) (first half))
	 (+ (* (first digit) 5)
	    (parse-new-roman-digit
	     roman (1+ start) end digit (cons nil (cdr unit)) (cons nil (cdr half)) fail)))
	(t (parse-roman-digit-sequence
            3 roman start end digit unit half #'parse-new-roman-digit fail))))

(defun parse-roman-integer (roman &key (start 0) end old-style)
  "Return the integer represented by the valid roman numeral, or nil.
Old-style uses four consecutive digits of a unit, while new-style
uses the next smaller unit before the unit or half-unit."
  (setq end (or end (length roman)))
  (when (< -1 start end (1+ (length roman)))
    (flet ((parse-failure (value)
	     (return-from parse-roman-integer value)))
      (funcall (if old-style #'parse-old-roman-digit #'parse-new-roman-digit)
	       roman start end '(1000 100 10 1) '(nil #\M #\C #\X #\I) '(nil #\D #\L #\V)
	       #'parse-failure))))

  This was actually written in one pass, but damned if I can read it only a
  day after it was written.
  
///
-- 
  The past is not more important than the future, despite what your culture
  has taught you.  Your future observations, conclusions, and beliefs are
  more important to you than those in your past ever will be.  The world is
  changing so fast the balance between the past and the future has shifted.