;Roman Numerals - Use tabular programming to produce Roman Numerals with minimal computation.
;Copyright (C) 2022 Prince Trippy <programmer@verisimilitudes.net>.

;This program is free software: you can redistribute it and/or modify it under the terms of the
;GNU Affero General Public License version 3 as published by the Free Software Foundation.

;This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
;even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
;See the GNU Affero General Public License for more details.

;You should have received a copy of the GNU Affero General Public License along with this program.
;If not, see <http://www.gnu.org/licenses/>.

(defvar bigger
  (make-array 40 :element-type 'string :initial-contents ;Using MAKE-ARRAY makes it harder to error.
              '(""
                "C"    "CC"    "CCC"    "CD"    "D"    "DC"    "DCC"    "DCCC"    "CM"    "M"
                "MC"   "MCC"   "MCCC"   "MCD"   "MD"   "MDC"   "MDCC"   "MDCCC"   "MCM"   "MM"
                "MMC"  "MMCC"  "MMCCC"  "MMCD"  "MMD"  "MMDC"  "MMDCC"  "MMDCCC"  "MMCM"  "MMM"
                "MMMC" "MMMCC" "MMMCCC" "MMMCD" "MMMD" "MMMDC" "MMMDCC" "MMMDCCC" "MMMCM")))

(defvar smaller
  (make-array 50 :element-type 'string :initial-contents
              '(""
                "I"    "II"    "III"    "IV"    "V"    "VI"    "VII"    "VIII"    "IX"    "X"
                "XI"   "XII"   "XIII"   "XIV"   "XV"   "XVI"   "XVII"   "XVIII"   "XIX"   "XX"
                "XXI"  "XXII"  "XXIII"  "XXIV"  "XXV"  "XXVI"  "XXVII"  "XXVIII"  "XXIX"  "XXX"
                "XXXI" "XXXII" "XXXIII" "XXXIV" "XXXV" "XXXVI" "XXXVII" "XXXVIII" "XXXIX" "X?"
                "X?I"  "X?II"  "X?III"  "X?IV"  "X?V"  "X?VI"  "X?VII"  "X?VIII"  "X?IX")))

(defvar l (make-array 10 :element-type 'bit :initial-contents '(0 0 0 0 0 1 1 1 1 0)))

(defvar h (make-array 10 :element-type '(member #\L #\C) :initial-contents
                      '(#\L #\L #\L #\L #\L #\C #\C #\C #\C #\C)))

(defparameter exceptions (pairlis '(0 18 22) '("NIHIL" "XIIX" "IIXX")))

(defun ad-verbum-ab-numero (integer)
  (check-type integer (integer 0 3999))
  (or (copy-seq (cdr (assoc integer exceptions :test '=)))
      (let* ((mod (mod integer 100)) (tenth (floor mod 10)))
        (concatenate 'string
                     (aref bigger (floor integer 100))
                     (aref #("" "L") (aref l tenth))
                     (substitute (aref h tenth) #\? (aref smaller (mod mod 50)) :test 'char=)))))

(defun ad-numerum-ab-verbo (string)
  (check-type string string)
  (or (car (rassoc string exceptions :test 'string-equal))
      (let* ((position (position-if (lambda (elt) (position elt "IVXL" :test 'char-equal)) string))
             (first (position (subseq string 0 position) bigger :test 'string-equal))
             (second (cond ((and position (char-equal #\L (char string position)))
                            (incf position) 50)
                           (t 0)))
             (third (position (if position (subseq string position) "") smaller
                              :test (lambda (first last)
                                      (or (string-equal first (substitute #\L #\? last
                                                                          :test 'char=))
                                          (if (string-equal first (substitute #\C #\? last
                                                                              :test 'char=))
                                              (setq second 50)))))))
        (and first third (let ((integer (+ second third (* first 100))))
                           (and (string-equal string (ad-verbum-ab-numero integer)) integer))))))

;As has become usual for me, Common Lisp falls short of the possible beauty, when I know what to do.
;This program is good for nothing more than a basic demonstration, only from its interactive nature.
.