Updated 2012-06-10 22:54:30 by RLE

See math::roman for a package which handles Roman numerals. It is a part of the math module of Tcllib.

Larry Smith Technically, there is no such thing. A "number" is a mathematical abstraction signifying a particular value (e.g. integers), a "numeral" is the set of glyphs used in a particular language to express a number. Hence, MDCLXVI and such consist of Roman Numerals, not "Roman numbers".

wdb: my approach
 namespace eval roman {}

 proc roman::under5 {x} {
    if {$x == 4} {
        return IV
    } else {
        string repeat I $x
    }
 }

 proc roman::under10 {x} {
    if {$x == 9} {
        return IX
    } elseif {$x >= 5} {
        set d [expr {$x - 5}]
        return V[under5 $d]
    } else {
        under5 $x
    }
 }

 proc roman::under50 {x} {
    if {$x == 49} {
        return IL
    } elseif {$x >= 40} {
        set d [expr {$x - 40}]
        return XL[under10 $d]
    } elseif {$x >= 10} {
        set d [expr {$x-10}]
        return X[under50 $d]
    } else {
        under10 $x
    }
 }

 proc roman::under100 {x} {
    if {$x == 99} {
        return IC
    } elseif {$x >= 90} {
        set d [expr {$x - 90}]
        return XC[under10 $d]
    } elseif {$x >= 50} {
        set d [expr {$x - 50}]
        return L[under50 $d]
    } else {
        under50 $x
    }
 }

 proc roman::under500 {x} {
    if {$x == 499} {
        return ID
    } elseif {$x >= 490} {
        set d [expr {$x - 490}]
        return XD[under100 $d]
    } elseif {$x >= 400} {
        set d [expr {$x - 400}]
        return CD[under100 $d]
    } elseif {$x >= 100} {
        set d [expr {$x - 100}]
        return C[under500 $d]
    } else {
        under100 $x
    }
 }

 proc roman::under1000 {x} {
    if {$x == 999} {
        return IM
    } elseif {$x >= 990} {
        set d [expr {$x - 990}]
        return XM[under10 $d]
    } elseif {$x >= 900} {
        set d [expr {$x - 900}]
        return CM[under100 $d]
    } elseif {$x >= 500} {
        set d [expr {$x - 500}]
        return D[under1000 $d]
    } else {
        under500 $x
    }
 }

 proc roman::roman {x} {
    if {$x >= 1000} {
        set d [expr {$x - 1000}]
        return M[roman $d]
    } else {
        under1000 $x
    }
 }

 namespace eval roman {namespace export roman}
 namespace import roman::roman

# [HJG] Test:
  catch {console show}
  puts [ roman::roman    9 ] ;# IX
  puts [ roman::roman   29 ] ;# XXIX
  puts [ roman::roman  138 ] ;# CXXXVIII
  puts [ roman::roman 1999 ] ;# MIM

# [BIBA] Rules:

 This program doesn't comply with Latin numbers writing rules :
 CI giving 101 is ok, but IC giving 99 is wrong! Right Answer is XCIX

 More examples : '49' must give 'XLIX' and not 'IL', '490' must give 'CDXC' and not 'XD', '999' must give 'CMXCIX' and not 'IM', and finally '1499' must give 'MCDXCIX' and not 'MID'.

 Conclusion: You can sub a symbol by the symbol 'JUST' preceeding it, not more !

 Other consideration:
 Maximum repetition for a letter is 3 (excepting for V,L,and D, where one occurence is allowed), so with the caracter set "MDCLXVI", max allowed number is '3999' ('MMMCMXCIX').

 Beyond this limit, new caracters are needed. The adopted solution was to modify the standard set by adding a line on caracter top:
 _
 X for 10000
 _
 V for 50000

wdb: according to these rules, there is just 1 (one) proc an 0 (zero) namespaces necessary:
 proc roman num {
    if {$num < 10} then {
        string map {
            IIIIIIIII IX
            IIIII V
            IIII IV
        } [string repeat I $num]
    } elseif {$num < 100} then {
        set bigLiteral [expr {int($num / 10)}]
        set bigNum [expr {$bigLiteral * 10}]
        set smallNum [expr {$num - $bigNum}]
        set romanLiteral [string map {
            XXXXXXXXX XC
            XXXXX L
            XXXX XL
        } [string repeat X $bigLiteral]]
        append romanLiteral [roman $smallNum]
    } elseif {$num < 1000} then {
        set bigLiteral [expr {int($num / 100)}]
        set bigNum [expr {$bigLiteral * 100}]
        set smallNum [expr {$num - $bigNum}]
        set romanLiteral [string map {
            CCCCCCCCC CD
            CCCCC D
            CCCC CD
        } [string repeat C $bigLiteral]]
        append romanLiteral [roman $smallNum]        
    } elseif {$num < 4000} then {
        set bigLiteral [expr {int($num / 1000)}]
        set bigNum [expr {$bigLiteral * 1000}]
        set smallNum [expr {$num - $bigNum}]
        set romanLiteral [string map {
            MMMM MD
        } [string repeat M $bigLiteral]]
        append romanLiteral [roman $smallNum]        
    } else {
        return -code error [list max roman literal connnotes 3999]
    }
 }

RS still prefers the version over at Roman numerals :) wdb your one has better style, but my one is more quick'n'dirty ;-)=)