漢数字をアラビア数字に変換する、というお題は、プログラミングでよく見かけますが、Tclで書かれたものが見つからなかったので挑戦しました。台湾のドキュメントとか扱っていると、たまにこういう変換が欲しくなります。
proc kanji2num {str} {
#桁を表す漢字のdict
set digit [dict create]
set dlist [list "億" "100000000" "万" "10000" "千" "1000" "百" "100" "十" "10"]
foreach {d n} $dlist {dict set digit $d $n}
set temp ""
set dgt ""
set result 0
while {[regexp -indices -- {([零〇一二三四五六七八九億万千百十]+)} $str match range]} {
set start [lindex $range 0]
set end [lindex $range 1]
#漢数字を切り出す
set kanjinum [string range $str $start $end]
for {set i 0} {$i < [string length $kanjinum]} {incr i} {
set cur [string index $kanjinum $i]
#桁を表す漢字なら
if {[dict exists $digit $cur]} {
if {$dgt != ""} {
if {$cur == "万" || $cur == "億"} {
#千万、百億
set dgt [expr $dgt * [dict get $digit $cur]]
} else {
#百十
set dgt [expr $dgt + [dict get $digit $cur]]
}
} else {
set dgt [dict get $digit $cur]
}
} else {
if {$dgt != ""} {
if {$temp == ""} {set temp 1}
set result [expr $result + [expr $temp * $dgt]]
set temp ""
}
set dgt ""
set num [string map {零 0 〇 0 一 1 二 2 三 3 四 4 五 5 六 6 七 7 八 8 九 9} $cur]
#ここで「零」に注意しないと「民國一百零八年」などでエラーが出る
if {$num != 0} {append temp $num}
}
}
if {$dgt != ""} {
if {$temp == ""} {set temp 1}
set result [expr $result + [expr $temp * $dgt]]
} else {
if {$temp != ""} {set result [expr $result + $temp]}
}
set str [string replace $str $start $end $result]
set temp ""
set dgt ""
set result 0
}
return $str
}
ムチャクチャ苦戦しました。。。1 千万、百万とか百十のように桁を表す漢字が連続するケースが難しかったです。以下、使用例です。
set str 「經濟部國營事業委員會降低漏水率計畫（一百零二至一百十一年）推動小組作業要點」修正為「經濟部國營事業委員會降低漏水率計畫（一百零二至一百十三年）推動小組作業要點」，並修正規定，自即日生效。
set result [kanji2num $str]
puts $result
「經濟部國營事業委員會降低漏水率計畫（102至111年）推動小組作業要點」修正為「經濟部國營事業委員會降低漏水率計畫（102至113年）推動小組作業要點」，並修正規定，自即日生效。
set str 七億五千万二百五十
set result [kanji2num $str]
puts $result
750000250
set str 山本五十六
set result [kanji2num $str]
puts $result
山本56
56が悲しいことになっていますが、形態素解析してないのでこの関数の限界です。大きい数字は桁区切りのカンマとか入れる機能を加えると良さそう。
というかTclで書いてみましたが、これはワードのマクロにすべきじゃないかと今気づきました。
- おまけに当初のコードにミスがあったので修正しました涙 [↩]
