Parsing Roman Numerals

romannums.lisp

(defparameter +lookups+ '((CM . 900)
                          (M  . 1000)
                          (CD . 400)
                          (D  . 500)
                          (XC . 90)
                          (C  . 100)
                          (XL . 40)
                          (L  . 50)
                          (IX . 9)
                          (X  . 10)
                          (IV . 4)
                          (V  . 5)
                          (I  . 1)))

(defun as-syms (s)
  (loop for c across s collect (intern (string c))))

(defun comb (a b) (intern (format nil "~a~a" a b)))

(defun syms->int (inp)
  (if (null inp)
      0
      (let ((a0 (when (< 1 (length inp))
                  (cdr (assoc (comb (car inp) (cadr inp)) +lookups+))))
            (a1 (cdr (assoc (car inp) +lookups+))))
        (if a0
            (+ a0 (syms->int (cddr inp)))
            (+ a1 (syms->int (cdr inp)))))))

(defun parse-roman (num-str)
  (syms->int (as-syms num-str)))

(parse-roman "III")     ;;=> 3
(parse-roman "XVI")     ;;=> 16
(parse-roman "XXVII")   ;;=> 27
(parse-roman "XLVIII")  ;;=> 48
(parse-roman "XLIX")    ;;=> 49
(parse-roman "DCLXVI")  ;;=> 666
(parse-roman "MDCLXVI") ;;=> 1666

toroman.lisp

;; You should really use `format` for this!

(defparameter *chunks* '((1000 . "M")
                         (900  . "CM")
                         (500  . "D")
                         (400  . "CD")
                         (100  . "C")
                         (90   . "XC")
                         (50   . "L")
                         (40   . "XL")
                         (10   . "X")
                         (9    . "IX")
                         (5    . "V")
                         (4    . "IV")
                         (1    . "I")))

(defun find-highest-subnum (target)
  (loop for pair in *chunks*
        do (when (<= (car pair) target)
             (return pair))))

(defun romanize (num)
  (let ((pair (find-highest-subnum num)))
    (if (not pair)
        ""
        (format nil "~a~a"
                (cdr pair)
                (romanize (- num (car pair)))))))