diff options
author | Kjetil Orbekk <kj@orbekk.com> | 2021-11-21 14:03:26 -0500 |
---|---|---|
committer | Kjetil Orbekk <kj@orbekk.com> | 2021-11-21 14:03:26 -0500 |
commit | b2ea7ebefce50179f51913aae736670658190db6 (patch) | |
tree | 28dd6579efeed824adacaf10e5bae180d31240a2 /exercism/emacs-lisp/roman-numerals | |
parent | 304c2c81295ce8e9e84018261ad3d08cb6dce671 (diff) |
implement roman numerals
Diffstat (limited to 'exercism/emacs-lisp/roman-numerals')
-rw-r--r-- | exercism/emacs-lisp/roman-numerals/roman-numerals.el | 47 |
1 files changed, 47 insertions, 0 deletions
diff --git a/exercism/emacs-lisp/roman-numerals/roman-numerals.el b/exercism/emacs-lisp/roman-numerals/roman-numerals.el index 7ee7f15..9b556fd 100644 --- a/exercism/emacs-lisp/roman-numerals/roman-numerals.el +++ b/exercism/emacs-lisp/roman-numerals/roman-numerals.el @@ -4,7 +4,54 @@ ;;; Code: +(require 'cl-macs) +(defun rn/unfold (fn x) + (let ((res (funcall fn x))) + (when (car res) + (cons (car res) (rn/unfold fn (cdr res)))))) + +(defun rn/decimal-digits (number) + "Return the decimal digits of NUMBER as a little-endian list." + (rn/unfold (lambda (x) + (when (> x 0) + (cons (% x 10) (/ x 10)))) number)) + +(defun rn/zip (l1 l2) + (when (and l1 l2) + (cons (cons (car l1) (car l2)) + (rn/zip (cdr l1) (cdr l2))))) + +(defun rn/roman-digit (number symbols) + (cl-destructuring-bind (one five ten) symbols + (cond + ((eql 0 number) '()) + ((eql 1 number) (list one)) + ((eql 2 number) (list one one)) + ((eql 3 number) (list one one one)) + ((eql 4 number) (list one five)) + ((eql 5 number) (list five)) + ((eql 6 number) (list five one)) + ((eql 7 number) (list five one one)) + ((eql 8 number) (list five one one one)) + ((eql 9 number) (list one ten)) + ((eql 10 number) (list ten))))) + +(defvar rn/roman-symbols + '(("I" "V" "X") + ("X" "L" "C") + ("C" "D" "M") + ("M" nil nil))) + +(defun to-roman (number) + (when (> number 3000) + (error 'number-too-big)) + (let* ((decimal-digits (rn/decimal-digits number)) + (roman-digits + (mapcar (lambda (digit_syms) + (rn/roman-digit (car digit_syms) (cdr digit_syms))) + (rn/zip decimal-digits rn/roman-symbols)))) + (apply 'concat (mapcan 'identity (reverse roman-digits))))) (provide 'roman-numerals) ;;; roman-numerals.el ends here |