codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
(define (roman->number roman) (let ((romans '((#\M 1000) (#\D 500) (#\C 100) (#\L 50) (#\X 10) (#\V 5) (#\I 1)))) (let loop ((roman (map char-upcase (string->list roman))) (prior 10000) (number 0)) (cond ((null? roman) number) ((< prior (cadr (assoc (car roman) romans))) (loop (cdr roman) 10000 (+ number (cadr (assoc (car roman) romans)) (* prior -2)))) (else (loop (cdr roman) (cadr (assoc (car roman) romans)) (+ number (cadr (assoc (car roman) romans))))))))) (define (number->roman n) (if (and (integer? n) (> n 0)) (let loop ((n n) (romans '((1000 #\M) (500 #\D) (100 #\C) (50 #\L) (10 #\X) (5 #\V) (1 #\I))) (boundaries '(100 100 10 10 1 1 #f)) (s '())) (if (null? romans) (list->string (reverse s)) (let ((roman-val (caar romans)) (roman-dgt (cadar romans)) (bdry (car boundaries))) (let loop2 ((q (quotient n roman-val)) (r (remainder n roman-val)) (s s)) (if (= q 0) (if (and bdry (>= r (- roman-val bdry))) (loop (remainder r bdry) (cdr romans) (cdr boundaries) (cons roman-dgt (append (cdr (assv bdry romans)) s))) (loop r (cdr romans) (cdr boundaries) s)) (loop2 (- q 1) r (cons roman-dgt s))))))) (error 'number->roman "only positive integers can be romanized"))) (define (add-roman . xs) (number->roman (apply + (map roman->number xs)))) (display (add-roman "CCCLXIX" "CDXLVIII"))
Private
[
?
]
Run code
Submit