SHOW:
|
|
- or go back to the newest paste.
| 1 | ;; -*- coding: utf-8; mode: scheme -*- | |
| 2 | - | ;; $Id: num-roman.rkt,v 1.6 2012/02/04 21:44:33 alcides_fp Exp $ |
| 2 | + | ;; $Id: num-roman.rkt,v 1.14 2012/02/16 04:02:35 alcides_fp Exp $ |
| 3 | #lang racket | |
| 4 | ||
| 5 | (provide numeral) | |
| 6 | ||
| 7 | (define (numeral digito posicion) | |
| 8 | - | (let ((matriz-numerales |
| 8 | + | (let ((matriz-numerales |
| 9 | #(#("" "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX")
| |
| 10 | #("" "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC")
| |
| 11 | #("" "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM")
| |
| 12 | #("" "M" "MM" "MMM"))))
| |
| 13 | - | (vector-ref (vector-ref matriz-numerales posicion) digito) )) |
| 13 | + | (vector-ref (vector-ref matriz-numerales posicion) digito) ) ) |
| 14 | ;;------------------------------------------------------------------------ | |
| 15 | (provide dec->list) | |
| 16 | ||
| 17 | - | (define (dec->list numero) |
| 17 | + | (define (dec->list numero) |
| 18 | - | (let ((retval '()) |
| 18 | + | "Obtiene lista de cifras de un número base 10 en orden inverso" |
| 19 | - | (base 10) |
| 19 | + | (let loop ([cantidad numero][retval '()]) |
| 20 | - | (residuo 0)) |
| 20 | + | (if (= cantidad 0) retval |
| 21 | - | (do ((cantidad numero)) ((= cantidad 0) retval) |
| 21 | + | (loop (quotient cantidad 10) |
| 22 | - | (set! residuo (remainder cantidad base)) |
| 22 | + | (append retval (list (remainder cantidad 10))) ) ) ) ) |
| 23 | - | (set! retval (append retval (list residuo) )) |
| 23 | + | |
| 24 | - | (set! cantidad (quotient cantidad base)) ) ) ) |
| 24 | + | |
| 25 | ||
| 26 | (define (num-roman arabigo) | |
| 27 | (let ((cifras (dec->list arabigo))) | |
| 28 | (for/fold ((retval "")) | |
| 29 | - | (let ((retval "") |
| 29 | + | (((digito posicion)(in-indexed cifras))) |
| 30 | - | (lista-cifras '()) |
| 30 | + | (string-append (numeral digito posicion) retval) ) ) ) |
| 31 | - | (longitud 0) |
| 31 | + |
