Tcl: Թվերի արտահայտումը բառերով

Այս գրառման մեջ Tcl լեզվով իրականացված է 1-ից 999999 միջակայքի բնական թվերի բառային արտահայտման ալգորիթմը։ (Ամբողջական ֆայլը։)

#
# միավորների անունները հայերեն
#
set ONES {"" մեկ երկու երեք չորս հինգ վեց յոթ ութ ինը}

#
# տասնավորների անունները հայերեն
#
set TENS {"" տաս քսան երեսուն քառասուն հիսուն վաթսուն յոթանասուն ութսուն իննսուն}

#
# n-ը պատկանում է [a; b] միջակայքին
#
proc is_in { n a b } { 
  return [expr {($n >= $a) && ($n <= $b)}]
}

#
# վերադարձնում է երկու տարրերի ցուցակ, որոնցից առաջինը
# (ds / dr) քանորդն է, իսկ երկրորդը՝ (ds % dr) մնացորդը
#
proc divr { ds dr } {
  return [list [expr {$ds / $dr}] [expr {$ds % $dr}]]
}

#
# Հիմնական ձևափոխություն
#
proc number_to_words num {
  # եթե թիվը 0-9 միջակայքում է, ...
  if [is_in $num 0 9] {
    # ... ապա վերադարձնել միավորների ցուցակի համապատասխան տարրը
    return [lindex $::ONES $num]
  }

  # եթե թիվը 10-99 միջակայքում է, ...
  if [is_in $num 10 99] {
    # ... ապա առանձնացնել տասնավորի ու միավորի նիշը, ...
    lassign [divr $num 10] a b
    # ... ՛տաս՛-ով սկսվող բառերի համար տասնավորի ու միավորի 
    # միջև պետք է գրել ՛ն՛ տառը, օրինակ, ՛տասներկու՛, ...
    set s [expr {$a == 1 && $b != 0 ? {ն} : {}}]
    # ... վերադարձնել տասնավորների ու միավորների համապատասխան 
    # տարրերից կազմված արտահայտությունը
    return "[lindex $::TENS $a]${s}[lindex $::ONES $b]"
  }

  # եթե թիվը 100-999 միջակայքում է, ...
  if [is_in $num 100 999] {
    # ... ապա առանձնացնել հարյուրավորի նիշը և 100-ի բաժանելու մնացորդը, ...
    lassign [divr $num 100] a b
    # ... միավորների ցուցակից վերցնել հարյուրավորի նիշին համապատախան բառը,
    # նրան կցել ՛հարյուր՛ բառը, իսկ 100-ի բաժանելու մնացորդի վրա նորից կիրառել
    # number_to_words ֆունկցիան
    return "[lindex $::ONES $a] հարյուր [number_to_words $b]"
  }

  # եթե թիվը 1000-999999 միջակայքում է, ...
  if [is_in $num 1000 999999] {
    # ... ապա այն տրոհել երկու կտորի՝ 1000-ին բաժանելու քանորդ և մնացորդ, ...
    lassign [divr $num 1000] a b
    # ... ստացված կտորները ձևափոխել number_to_words ֆունկցիայով, 
    # և իրար կցել՝ արանքում դնելով ՛հազար՛ բառը
    return "[number_to_words $a] հազար [number_to_words $b]"
  }  

  return ""
}

Տեստավորման փորձ։

#
# գեներացնել [0;N) միջակայքի պատահական ամբողջ թիվ
#
proc random N {
  return [expr {int(rand() * $N)}]
}

#
# number_to_words ֆունկցիան փորձարկել 10 պատահական թվերով
#
for {set i 0} {$i < 10} {incr i} {
  set k [random 1000000]
  set v [number_to_words $k]
  puts "$k -- $v"
}