#lang scheme

;; File: Romano

;; Intérprete y Base de Conocimiento por separado
;; Una nueva versión.

;; Corrijo la coherencia del sistema de numeración romano.
;; Cuando un número es mayor que 1000, tratamos la parte 
;; inferior a 1000 según las reglas 
;; y la parte superior a 1000 es recursivamente tratada.

(define arabe->romano
  (lambda (n)
    (if (>= n 1000)
        (string-append
         (arabe->romano (quotient n 1000))
         "."
         (interprete (remainder n 1000)))
        (interprete n)) ))

(define interprete
  (lambda (x)
    (do
        ((n x)
         (reglas bc)
         (temp 0)
         (s ""))
      ((= n 0) s)
      (set! temp (aplica-regla n reglas) )
      (set! n (car temp))
      (set! s (string-append s (cdr temp))) )))
      
;; Qué regla aplicar

(define aplica-regla
  (lambda (n base)
    (cond
      ((null? base) "Fallo")
      ((not (apply ensaya-regla (cons n (car base))))
       (aplica-regla n (cdr base)))
      (else (apply ensaya-regla (cons n (car base)))) )))

;; Ejemplo de reglas

(define bc
  (list
   (list >= 900 "CM")
   (list >= 500 "D")
   (list >= 400 "CD")
   (list >= 100 "C")
   (list >= 90 "XC")
   (list >= 50 "L")
   (list >= 40 "XL")
   (list >= 10 "X")
   (list >= 9 "IX")
   (list >= 5 "V")
   (list >= 4 "IV")
   (list >= 1 "I") ))

;; Ensaya una regla. Argumentos: predicado valor resultado

(define ensaya-regla
  (lambda (n proc v r)
    (cond
     ((proc n v)
      (cons (- n v) r))
     (else #f))))

(provide arabe->romano)