** Summary ** Some "few-liner" code examples, started by [Richard Suchenwirth]. Help yourself! Add comments when you know it better! This page was split off from the more general [Bag of algorithms] page. ** Description ** [gold] Number spelling in India lead to a fuller sense of the zero, so number spelling is not as trivial as it looks. [http://weblogs.asp.net/ssadasivuni/archive/2004/04/02/106237.aspx%|%The Story of Indian Zero] [http://www.mediatinker.com/blog/archives/008821.html%|%A Brief History of Zero], Kristen McQuillin ,1997-07 (revised 2004-01) ** See Also ** [http://sourceforge.net/projects/rus-amount-tcl/%|%Russian money amount speller] (Roubles & Kopeks): can be easily used as a generic Russian number speller. [Chinese numbers]: [Hebrew numbers]: [Roman numbers]: [Morse code]: [Bag of algorithms]: ** Indian number speller ** e.g., 1760000000000: One Lakh Seventy Six Thousand Crore code available at [http://nagarajanchinnasamy.blogspot.in/2013/03/tcl-proc-to-convert-number-to-words.html%|%Nagu's Tcl Blog]. ** English number speller ** e.g., `en:num 29` => `twenty-nine` ====== proc en:num {n {optional 0}} { #---------------- English spelling for integer numbers if {[catch {set n [expr $n]}]} {return $n} if {$optional && $n==0} {return ""} array set dic { 0 zero 1 one 2 two 3 three 4 four 5 five 6 six 7 seven 8 eight 9 nine 10 ten 11 eleven 12 twelve } if [info exists dic($n)] {return $dic($n)} foreach {value word} {1000000 million 1000 thousand 100 hundred} { if {$n>=$value} { return "[en:num $n/$value] $word [en:num $n%$value 1]" } } ;#--------------- composing between 13 and 99... if $n>=20 { set res $dic([expr $n/10])ty if $n%10 {append res -$dic([expr $n%10])} } else { set res $dic([expr $n-10])teen } ;#----------- fix over-regular compositions regsub "twoty" $res "twenty" res regsub "threet" $res "thirt" res regsub "fourty" $res "forty" res regsub "fivet" $res "fift" res regsub "eightt" $res "eight" res set res } ;#RS ====== See also the converse [English number reader]. I have more such spellers for Arab, Hebrew, Chinese, Thai, but can't paste them here because of Unicode constants (not \u.. escaped). Tcl 8.1+ lets us look into a world where Unicodes can be cut and pasted like everything -- but the future is some time after today ;-) ** Better English speller :) ** keith lea: It's a bit longer, but it supports up to 65 digits (or so. I forget :) ====== set pronounce {vigintillion novemdecillion octodecillion \ septendecillion sexdecillion quindecillion quattuordecillion \ tredecillion duodecillion undecillion decillion nonillion \ octillion septillion sextillion quintillion quadrillion \ trillion billion million thousand ""} proc get_num num { foreach {a b} {0 {} 1 one 2 two 3 three 4 four 5 five 6 six 7 seven \ 8 eight 9 nine 10 ten 11 eleven 12 twelve 13 thirteen 14 \ fourteen 15 fifteen 16 sixteen 17 seventeen 18 eighteen 19 \ nineteen 20 twenty 30 thirty 40 forty 50 fifty 60 sixty 70 \ seventy 80 eighty 90 ninety} {if {$num == $a} {return $b}} return $num } proc revorder list { for {set x 0;set y [expr {[llength $list] - 1}]} {$x < $y} \ {incr x;incr y -1} { set t [lindex $list $x] set list [lreplace $list $x $x [lindex $list $y]] set list [lreplace $list $y $y $t] } return $list } proc pron_form num { global pronounce set x [join [split $num ,] {}] set x [revorder [split $x {}]] set pron "" set ct [expr {[llength $pronounce] - 1}] foreach {a b c} $x { set p [pron_num $c$b$a] if {$p != ""} { lappend pron "$p [lindex $pronounce $ct]" } incr ct -1 } return [join [revorder $pron] ", "] } proc pron_num num { set num [string trimleft $num 0-] set hundred "" set ten "" set len [string length $num] if {$len == 3} { set hundred "[get_num [string index $num 0]] hundred" scan [string range $num 1 end] %d num } if {$num > 20 && $num != $num/10} { set tens [get_num [string index $num 0]0] set ones [get_num [string index $num 1]] set ten [join [concat $tens $ones] -] } else { set ten [get_num $num] } if {[string length $hundred] && [string length $ten]} { return [concat $hundred and $ten] } else { # One of these is empty, but don't bother to work out which! return [concat $hundred $ten] } } ====== The result of the test below has been broken up over a few lines. :^) ======none % pron_form 12345678901234567890123456789012345678901234567890123456789012344 twelve vigintillion, three hundred and forty-five novemdecillion, six hundred and seventy-eight octodecillion, nine hundred and one septendecillion, two hundred and thirty-four sexdecillion, five hundred and sixty-seven quindecillion, eight hundred and ninety quattuordecillion, one hundred and twenty-three tredecillion, four hundred and fifty-six duodecillion, seven hundred and eighty-nine undecillion, twelve decillion, three hundred and forty-five nonillion, six hundred and seventy-eight octillion, nine hundred and one septillion, two hundred and thirty-four sextillion, five hundred sixty-seven and quintillion, eight hundred and ninety quadrillion, one hundred and twenty-three trillion, four hundred fifty-six billion, seven hundred and eighty-nine million, twelve thousand, three hundred and forty-four % ====== neat, eh? [DKF]: modified to put the word "and" in between a hundreds phrase and a tens-and-units phrase according to my grade-school math teacher, that would be a bug. The word 'and' is ONLY used to signify the decimal place. [DKF]: Your grade-school math teacher is wrong. Or at least not aware of the rules in all English-speaking locales. (Guess that's why they are a grade-school math teacher) [JBR]: Your grade school math teacher is correct for American English although this usage is no longer main stream. The "and" after hundreds and before tens and units is not typical usage in American English. [kpv]: fixed octal bug. The number 108 came back as "one hundred and 08" ** French number speller ** `fr:num 99` => `quatrevingt dix-neuf` ====== proc fr:num {n {optional 0}} { if {[catch {set n [expr $n]}]} {return $n} if {$optional && $n==0} {return ""} array set dic { 0 zero 1 un 2 deux 3 trois 4 quatre 5 cinq 6 six 7 sept 8 huit 9 neuf 10 dix 11 onze 12 douze 13 treize 14 quatorze 15 quinze 16 seize 20 vingt 30 trente 40 quarante 50 cinquante 60 soixante 80 quatre-vingt } if [info exists dic($n)] {return $dic($n)} foreach {value word} {1000000 million 1000 mille 100 cent} { if {$n>=$value} { return "[fr:num $n/$value] $word [fr:num $n%$value 1]" } } ;#--------------- composing between 13 and 99... if $n>=80 { set res $dic(80) if $n>80 {append res -[fr:num $n-80]} } elseif $n>=60 { set res $dic(60) if $n>60 {append res -[fr:num $n-60]} } elseif $n>=20 { set res $dic([expr $n/10]0) if $n%10 {append res -$dic([expr $n%10])} } else { set res dix-[fr:num $n-10] } set res } ;#RS ====== ** German number speller ** ====== proc de:num {n {optional 0}} { #---------------- German spelling for integer numbers if {[catch {set n [expr $n]}]} {return $n} if {$optional && $n==0} {return ""} array set dic { 0 null 1 ein 2 zwei 3 drei 4 vier 5 fünf 6 sechs 7 sieben 8 acht 9 neun 10 zehn 11 elf 12 zwölf } if [info exists dic($n)] {return $dic($n)} foreach {value word} {1000000 Million 1000 _tausend 100 _hundert_} { if {$n>=$value} { set res "[de:num $n/$value] $word [de:num $n%$value 1]" regsub " _" $res "" res regsub "_ " $res "" res return $res } } ;#--------------- composing between 13 and 99... if $n>=20 { set res $dic([expr $n/10])zig if $n%10 {set res $dic([expr $n%10])und$res} } else { set res $dic([expr $n-10])zehn } ;#----------- fix over-regular compositions regsub "chsz" $res "chz" res regsub "benz" $res "bz" res regsub "weizi" $res "wanzi" res regsub "dreizig" $res "dreißig" res set res } ;#RS ====== ** Swedish number speller ** ====== proc sv:num {n {optional 0}} { #---------------- Swedish spelling for integer numbers # Based on en|fr|de:num by Richard Suchenwirth # Adapted to Swedish by Peter Lewerin 2001-06-10 if {[catch {set n [expr $n]}]} {return $n} if {$optional && $n==0} {return ""} array set dic { 0 noll 1 ett 2 två 3 tre 4 fyra 5 fem 6 sex 7 sju 8 åtta 9 nio 10 tio 11 elva 12 tolv 14 fjorton 18 arton } if [info exists dic($n)] {return $dic($n)} foreach {value word} {1000000000 miljard 1000000 miljon 1000 _tusen 100 _hundra_} { if {$n>=$value} { set s {} if {$word == "miljard" || $word == "miljon"} { set v [expr {$n/$value}] if {$v == 1} { set s "en $word" } else { set s "[sv:num $v] ${word}er" } } else { set s "[sv:num $n/$value] ${word}" } set res "$s [sv:num $n%$value 1]" regsub " _" $res "" res regsub "_ " $res "" res regsub " $" $res "" res regsub "ttt" $res "tt" res return $res } } ;#--------------- composing between 13 and 99... if {$n>=20} { set res $dic([expr $n/10])tio if $n%10 {set res $res$dic([expr $n%10])} } else { set res $dic([expr $n-10])ton } ;#----------- fix over-regular compositions regsub "ret" $res "rett" res regsub "jut" $res "jutt" res regsub "niot" $res "nitt" res regsub "tvåti" $res "tjug" res regsub "fyrat" $res "fyrt" res regsub "ttat" $res "tt" res set res } ====== ** Italian number speller ** ====== proc it:num {n {optional 0}} { #---------------- Italian spelling for integer numbers #---------------- by Stefano Taschini 2002-05-15 #---------------- based on a template by Richard Suchenwirth if {[catch {set n [expr $n]}]} {return $n} if {$optional && $n==0} {return ""} array set dic { 0 zero 1 uno 2 due 3 tre 4 quattro 5 cinque 6 sei 7 sette 8 otto 9 nove 10 dieci 11 undici 12 dodici 13 tredici 14 quattordici 15 quindici 16 sedici 17 diciassette 18 diciotto 19 diciannove 20 venti 30 trenta 40 quaranta 50 cinquanta 60 sessanta 70 settanta 80 ottanta 90 novanta } if [info exists dic($n)] {return $dic($n)} #--------------- recursive for numbers greater than 99 foreach {value sing plur} {1000000000 "un miliardo, " " miliardi, " 1000000 "un milione, " " milioni, " 1000 "mille " "mila " 100 cento cento } { if {$n>=$value} { if {$n >= 2*$value} {set res [it:num $n/$value]$plur} {set res $sing} append res [it:num $n%$value 1] regsub ",? *$" $res "" res regsub {ém} $res {em} res regsub {oo} $res {o} res return $res } } #--------------- composing between 21 and 99... set dic(3) "tré" regsub {nt[ia]([uo])} $dic([expr $n/10]0)$dic([expr $n%10]) {nt\1} res set res } ====== ** Turkish number speller ** `tr:num 99` => `doksan-dokuz` ====== proc tr:num {n {optional 0}} { #---------------- Turkish spelling for integer numbers # Based on en|fr|de:num by Richard Suchenwirth # Adapted to Turkish by Sedat Serper [SeS] 2012-05-09 if {[catch {set n [expr $n]}]} {return $n} if {$optional && $n==0} {return ""} array set dic { 0 SIFIR 1 bir 2 iki 3 üç 4 dört 5 bes 6 alti 7 yedi 8 sekiz 9 dokuz } if [info exists dic($n)] {return $dic($n)} foreach {value word} {1000000000 milyar 1000000 milyon 1000 bin 100 yüz} { if {$n>=$value} { regsub "bir y" "[tr:num $n/$value] $word [tr:num $n%$value 1]" "y" res regsub "bir b" $res "b" res return $res } } ;#--------------- composing between 10 and 99... if $n>=10 { set res $dic([expr $n/10])t if $n%10 {append res -$dic([expr $n%10])} } else { set res $dic([expr $n-10]) } ;#----------- fix over-regular compositions regsub "birt" $res "on" res regsub "ikit" $res "yirmi" res regsub "üçt" $res "otuz" res regsub "dörtt" $res "k?rk" res regsub "best" $res "elli" res regsub "altit" $res "altmis" res regsub "yedit" $res "yetmis" res regsub "sekizt" $res "seksen" res regsub "dokuzt" $res "doksan" res set res } ;#SeS ====== ** Dutch number speller ** `nl:num 99` => `negen-en-negentig` ====== proc nl:num {n {optional 0}} { #---------------- Dutch spelling for integer numbers # Based on en|fr|de:num by Richard Suchenwirth # Adapted to Dutch by Sedat Serper [SeS] 2012-05-09 if {[catch {set n [expr $n]}]} {return $n} if {$optional && $n==0} {return ""} array set dic { 0 nul 1 een 2 twee 3 drie 4 vier 5 vijf 6 zes 7 zeven 8 acht 9 negen 10 tien 11 elf 12 twaalf } if [info exists dic($n)] {return $dic($n)} foreach {value word} {1000000000 miljard 1000000 miljoen 1000 _duizend 100 _honderd_} { if {$n>=$value} { set res "[nl:num $n/$value] $word [nl:num $n%$value 1]" regsub " _" $res "" res regsub "_ " $res "" res return $res } } ;#--------------- composing between 13 and 99... if $n>=20 { set res $dic([expr $n/10])tig if $n%10 {set res $dic([expr $n%10])-en-$res} } else { set res $dic([expr $n-10])tien } ;#----------- fix over-regular compositions regsub "tweetig" $res "twintig" res regsub "drietien" $res "dertien" res regsub "drietig" $res "dertig" res regsub "viertien" $res "veertien" res regsub "viertig" $res "veertig" res regsub "achttig" $res "tachtig" res set res } ;#SeS ====== ** German time speller ** Converts exact HH:MM times to fuzzy colloquial wording, optional Northern (viertel vor vier) or Southern style (dreiviertel vier) ;-) Requires de:num (see above) ====== proc de:time {{t now} {region n}} { # format HH:MM time to spoken German (north or south) set u "usage: de:time HH:MM|now ?n|s?" if {$t=="now"} {set t [clock format [clock seconds] -format %H:%M]} if [scan $t %d:%d h min]!=2 {error $u} array set dic { 5 fünf z zehn V Viertel h halb d dreiviertel v vor n nach + "" }; # dictionary of words used (digits also from de:num) switch -- $region { n {set cdic {{} 5n zn Vn zvh 5vh h 5nh znh Vv zv 5v +}} s {set cdic {{} 5n zn V zvh 5vh h 5nh znh d zv 5v +}} default {error $u} }; # byte-coded names for 5-minute increments (see dic) set m5 [expr int(round($min/5.))] set phr [lindex $cdic $m5] if {[regexp {[vVhd+]} $phr] && ![regexp Vn $phr]} {incr h} if ![set h [expr $h%12]] {set h 12} if ![regexp {[vn]} $phr] { set d [expr $min-$m5*5] if $d<0 { set res "kurz vor " } elseif $d>0 { set res "kurz nach " } else { set res "genau " } } foreach i [split $phr ""] {if {$i!="+"} {lappend res $dic($i)}} lappend res [de:num $h] regsub ein$ $res eins res set res } ;#RS ====== ** English ordinal suffix ** ====== proc en_ordinal n { set suffix th if {($n%100)<10 || ($n%100)>20} { switch -- [expr abs($n)%10] { 1 {set suffix st} 2 {set suffix nd} 3 {set suffix rd} } } append n $suffix } ;# RS ====== ======none % en_ordinal 1 1st % en_ordinal 2 2nd % en_ordinal 3 3rd % en_ordinal 4 4th ====== [MG] 2004-04-02: And another, which only requires that the string ends in a number, and is also forgiving of strings which don't. ====== proc en_ordinal2 {num} { regexp {^[^0-9]*([0-9]+)$} $num -> tnum if {$tnum == "11" || $tnum == "12" || $tnum == "13"} { return ${num}th; } switch [string range $num end end] { 1 {append num st} 2 {append num nd} 3 {append num rd} 4 - 5 - 6 - 7 - 8 - 9 - 0 {append num th} } return $num; } ====== [RS]: Note however that this version reacts wrong in the range 11..13: ====== % en_ordinal2 11 11st % en_ordinal2 12 12nd % en_ordinal2 13 13rd ====== [MG]: So it does. Fixed now so that it works properly. Also fixed so that numbers ending in '0' get 'th' rather than nothing added. ---- [MG]: ''Second Formatter'' moved to [Formatting durations], now that I've stumbled across the right page. <> Mathematics | Package | Human Language | Date and Time | Local | Arts and crafts of Tcl-Tk programming