Welcome, guest | Sign In | My Account | Store | Cart

Takes an integer between 1 and 3999 and converts it to Roman Numerals

Tcl, 32 lines
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
proc toRoman {arabic} {
  #September 2001 by George M Jempty: jb4mt@webfielding.com
  
  if {![string is integer -strict $arabic] || $arabic < 1 || $arabic > 3999} {
    return -code error "Please retry with an integer from 1 to 3999"
  }
  
  set numerals [list I V X L C D M]
  set index 0
  set roman ""
  
  while {$arabic} {
    set digit [expr {$arabic%10}]
    set arabic [expr {$arabic/10}]
    set place ""

    if {$digit == 4 || $digit == 9} {
      set place [lindex $numerals [expr {$digit/4 + $index}]]
      set place [lindex $numerals $index]$place
    } else {
      for {set pad 0} {$pad < [expr {$digit%5}]} {incr pad} {
	set place [lindex $numerals $index]$place
      }
      if {$digit >= 5} {
        set place [lindex $numerals [expr {$index+1}]]$place
      }
    }
    incr index 2
    set roman $place$roman
  }  
  return $roman
}

Limited to numbers under 4000 because the appropriate character for 5000 (and therefore one thousand fewer than 5000, ergo 4000) is not an ASCII character.

3 comments

Jeff Hobbs 20 years, 3 months ago  # | flag

Needs work. This unfortunately spins indefinitely when I do 'toRoman 99'. Also, expressions should be braced for speed.

George Jempty (author) 20 years, 3 months ago  # | flag

One fix down one to go. OK, I fixed the endless loop thing, caused by me incompletely eradicating an unrequired variable and then not testing it.

When you say grouping "expressions" with braces, do you mean my math "expr"s?

Keith Vetter 18 years, 7 months ago  # | flag

Richard Suchenwirth has a nice slick way of doing arabic->roman conversion (see http://mini.net/tcl/1749 for more details):

proc roman:number {i} {
    set res ""
    foreach {value roman} {
        1000 M 900 CM 500 D 400 CD 100 C 90 XC 50 L 40 XL 10 X 9 IX 5 V 4 IV 1 I} {
        while {$i>=$value} {
            append res $roman
            incr i -$value
        }
    }
    set res
}
Created by George Jempty on Sat, 8 Sep 2001 (MIT)
Tcl recipes (162)
George Jempty's recipes (1)

Required Modules

  • (none specified)

Other Information and Tasks