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 50000wdb: 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 ;-)=)