Roman numerals

p89.lisp

@@ -0,0 +1,65 @@
+(defparameter *roman-numerals* '((#\I . 1)
+				 (#\V . 5)
+				 (#\X . 10)
+				 (#\L . 50)
+				 (#\C . 100)
+				 (#\D . 500)
+				 (#\M . 1000)))
+
+(defparameter *roman-numeral-digits* '((#\I #\V #\X)
+				       (#\X #\L #\C)
+				       (#\C #\D #\M)
+				       (#\M)))
+
+(defun parse-roman-numerals (string)
+  "Parses STRING as a value written in Roman numerals, using only the 'descending order' rule"
+  (loop with sum = 0
+	for last-value = nil then value
+	for character across string
+	for value = (cdr (assoc character *roman-numerals*))
+	do (if (and last-value (< last-value value))
+	       (incf sum (- value (* 2 last-value)))
+	       (incf sum value))
+	finally (return sum)))
+
+(defun digits (value)
+  "Returns a list of the base-10 digits in positive integer VALUE"
+  (loop with digits = nil
+	for digit = (mod value 10)
+	while (> value 0)
+	do (push digit digits)
+	   (setf value (floor value 10))
+	finally (return digits)))
+
+(defun nconc-lists (lists)
+  "NCONCs LISTS together"
+  (apply #'nconc lists))
+
+(defun format-roman-numeral (value)
+  "Formats VALUE as a minimal Roman numeral string"
+  (-> (loop for digit in (nreverse (digits value))
+	    for (one five ten) in *roman-numeral-digits*
+	    collect (ecase digit
+		      (0 nil)
+		      (1 (list one))
+		      (2 (list one one))
+		      (3 (list one one one))
+		      (4 (if five
+			     (list one five)
+			     (list one one one one)))
+		      (5 (list five))
+		      (6 (list five one))
+		      (7 (list five one one))
+		      (8 (list five one one one))
+		      (9 (list one ten))))
+      (nreverse)
+      (nconc-lists)
+      (coerce 'string)))
+
+(defun roman-numerals ()
+  (let* ((lines (uiop:read-file-lines "0089_roman.txt"))
+	 (characters-original (loop for line in lines sum (length line)))
+	 (values (loop for line in lines collect (parse-roman-numerals line)))
+	 (lines-minimal (loop for value in values collect (format-roman-numeral value)))
+	 (characters-minimal (loop for line in lines-minimal sum (length line))))
+    (- characters-original characters-minimal)))

shared.lisp

@@ -3,6 +3,18 @@
   `(let ,(loop for name in names collect `(,name (gensym)))
      ,@body))
 
+(defmacro -> (start &rest rest)
+  (loop with result = start
+	for (head . tail) in rest
+	do (setf result (cons head (cons result tail)))
+	finally (return result)))
+
+(defmacro ->> (start &rest rest)
+  (loop with result = start
+	for form in rest
+	do (setf result (append form (list result)))
+	finally (return result)))
+
 (defun get-primes (max)
   "Return a list of the first primes up to MAX"
   (let ((primes nil)