ActiveState Code

Recipe 68379: Conversion to Roman Numerals

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

Tcl 
 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
}

Discussion

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.

Comments

  1. 1. At 11:06 a.m. on 10 sep 2001, Jeff Hobbs said:

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

  2. 2. At 11:21 a.m. on 10 sep 2001, George Jempty (the author) said:

    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?

  3. 3. At 8:45 a.m. on 6 may 2003, Keith Vetter said:

    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
}

Sign in to comment