時代遅れひとりFizzBuzz祭り Tcl編

時代遅れひとりFizzBuzz祭り、今回はTcl。前回がLuaだったので、その流れで「元祖アプリケーション組み込み用言語*1」のTclを引っ張り出してみた。この「元祖」は単なる言葉のあやなので、深く考えてはいけない。

Tclというと、世間的にはTcl/Tkと一括りで語られることが多いと思う。入門文書も「Tkありき」で書かれているものが大半ではないだろうか。実際のところ、簡単にGUIを構築できるTkは魅力的ではあるのだけど、しかし世間の流れとしては例えばWebブラウザ経由のサービスも増えてきている訳で、現在では単に「簡単にGUI構築」だけでは訴求力が低いのではないだろうか?

Tkを除外してTclの部分を見てみると、結構奥深い。ファイルや文字列の操作は充実していて、正規表現も使える。バイナリデータも処理可能。データ構造は連想配列とリストの両方に対応。そしてソケットによるTCP通信が非常に簡単にできる。

なので例えばPerlRubyで即席のツールをでっち上げるのと同じようなことをTclでもできるのではないかと思う。

ただTclはよく目にするプログラミング言語と比べると、

と結構独特というか見慣れない特徴を持っているというか正直少し変わっている言語なので*3、慣れないと苦労する。マイナー且つ日本語の情報が限られているので、苦労に拍車が掛かる。

Tclを使うのは数年ぶりで、随分前に試しにフィルタを書いて以来だ。なので色々と思い出しながら書いてみた。ちなみにTcl/Tk 8.4だ。

まずはオーソドックスな手続き型スタイルのFizzBuzzから。

#!/usr/bin/tclsh

proc fizzbuzz {n} {
	if {[expr $n % 15] == 0} {
		return FizzBuzz
	} elseif {[expr $n % 3] == 0} {
		return Fizz
	} elseif {[expr $n % 5] == 0} {
		return Buzz
	} else {
		return $n
	}
}

for {set i 1} {$i <= 100} {incr i} {
	puts [fizzbuzz $i]
}

この時点で既にTcl的な何かが醸し出されている。{}の多用や[]の使い方辺りがそうだ。文字列がクォート文字等で囲まれていないが、これはシェルスクリプトを見慣れている人なら違和感を感じないかもしれない。

しかしそれ以外は、見た目としては構造化された手続き型言語だ。

#!/usr/bin/tclsh

proc fizzbuzz {n} {
	set str ""

	if {[expr $n % 3] == 0} {
		set str Fizz
	}
	if {[expr $n % 5] == 0} {
		append str Buzz
	}

	if {[string length $str] == 0} {
		return $n
	} else {
		return $str
	}
}

for {set i 1} {$i <= 100} {incr i} {
	puts [fizzbuzz $i]
}

これでも特に制御構文が用意されているわけではなく、ifもforもシェルスクリプトと同じく単なるコマンドに過ぎない。改行がコマンドの区切りとして解釈されるので、その辺りに注意してコードを書く必要がある。

Tclにはデータ構造としてリストと配列が用意されている。このうちリストは、その名前と異なりC言語C++PerlRubyなどの他の言語でいうところの配列に近い*4

#!/usr/bin/tclsh

proc fizzbuzz {n} {
	set ref_tbl [list $n Fizz Buzz FizzBuzz]
	set fizz 0
	set buzz 0

	if {[expr $n % 3] == 0} {
		set fizz 1
	}
	if {[expr $n % 5] == 0} {
		set buzz 2
	}

	return [lindex $ref_tbl [expr $fizz + $buzz]]
}

for {set i 1} {$i <= 100} {incr i} {
	puts [fizzbuzz $i]
}

コマンドlistでリストを生成し、ref_tblにセットしている。リストの要素にはlindexで0から始まるインデックス番号を指定してアクセスしている。

リストは次のように生成することもできる。

#!/usr/bin/tclsh

proc fizzbuzz {n} {
	set ref_tbl "$n Fizz Buzz FizzBuzz"
	if {[expr $n % 3] == 0} {set fizz 1} else {set fizz 0}
	if {[expr $n % 5] == 0} {set buzz 2} else {set buzz 0}

	return [lindex $ref_tbl [expr $fizz + $buzz]]
}

for {set i 1} {$i <= 100} {incr i} {
	puts [fizzbuzz $i]
}

この場合、ref_tblに値をセットした段階では値は文字列の状態で、コマンドlindexでアクセスした段階で文字列からリストに変換されるらしい。一般的には、リストはコマンドlistで生成した方が効率的なようだ。

Tclの配列は連想配列で、Perlのハッシュ変数やRubyのHashクラスに近い。

#!/usr/bin/tclsh

proc fizzbuzz {n} {
	array set ref_tbl "
		0 $n
		1 Fizz
		2 Buzz
		3 FizzBuzz
	"
	if {[expr $n % 3] == 0} {set fizz 1} else {set fizz 0}
	if {[expr $n % 5] == 0} {set buzz 2} else {set buzz 0}

	return $ref_tbl([expr $fizz + $buzz])
}

for {set i 1} {$i <= 100} {incr i} {
	puts [fizzbuzz $i]
}

コマンドarray setを使って、添字と値を並べたリストから配列を生成している。この書き方が「PerlRubyのハッシュに近い」というイメージを助長しているのかもしれない。

ところでマニュアルによるとifは最後に実行したコマンドの結果を返すらしい。switchという多岐分岐のコマンドも同様だ。プロシージャも、明示的にreturnを実行しない場合は最後に実行したコマンドの値を返す。なのでこんな書き方もできる。

#!/usr/bin/tclsh

proc fizzbuzz {n} {
	set fizz [if {[expr $n % 3] == 0} {expr 1} else {expr 0}]
	set buzz [if {[expr $n % 5] == 0} {expr 2} else {expr 0}]

	switch [expr $fizz + $buzz] {
		1 {subst Fizz}
		2 {subst Buzz}
		3 {subst FizzBuzz}
		default {subst $n}
	}
}

for {set i 1} {$i <= 100} {incr i} {
	puts [fizzbuzz $i]
}

LispOCamlっぽい感じだ。但しTcl/Tkらしい書き方ではないらしいので、自重するべきだろう。

と言いつつ、もう少し掘り下げてみる。

素のTcl 8.4には無名関数やクロージャは無いらしい。Tcl 8.5ならコマンドapplyを使って無名関数っぽいことが可能だし、Jimという処理系ならクロージャがあるらしいが、Tcl 8.4ではNGだ。

とはいえ、Tclは「何でも文字列」なので、そのことを利用*5して高階関数的なことができそうだ。ということで試してみた。

#!/usr/bin/tclsh

proc fizzbuzz {n} {
	set fizz [if {[expr $n % 3] == 0} {expr 1} else {expr 0}]
	set buzz [if {[expr $n % 5] == 0} {expr 2} else {expr 0}]

	switch [expr $fizz + $buzz] {
		1 {subst Fizz}
		2 {subst Buzz}
		3 {subst FizzBuzz}
		default {subst $n}
	}
}

# 0〜n-1の各値に対して argを仮引数とする blockを実行し、
# その結果を要素とする n個のリストを生成する。
proc make_list {nelems arg block} {
	set retval [list]

	for {set i 0} {$i < $nelems} {incr i} {
		set $arg $i
		lappend retval [eval $block]
	}

	return $retval
}

# リストlst の各要素を引数としてfnを実行する
proc list_each {fn lst} {
	for {set i 0} {$i < [llength $lst]} {incr i} {
		$fn [lindex $lst $i]
	}
}

list_each puts [make_list 100 n {fizzbuzz [expr $n + 1]}]

make_listはブロック*6を引数として受け取る。受け取ったブロックはコマンドevalで実行される*7。list_eachは実行するプロシージャ名を引数として受け取り、内部で普通に実行する。

蛇足ながら書いておくと、実用的(?)にはlist_eachは不要だ。標準のコマンドforeachを使えばよい。

#!/usr/bin/tclsh

proc fizzbuzz {n} {
	set fizz [if {[expr $n % 3] == 0} {expr 1} else {expr 0}]
	set buzz [if {[expr $n % 5] == 0} {expr 2} else {expr 0}]

	switch [expr $fizz + $buzz] {
		1 {subst Fizz}
		2 {subst Buzz}
		3 {subst FizzBuzz}
		default {subst $n}
	}
}

# 0〜n-1の各値に対して argを仮引数とする blockを実行し、
# その結果を要素とする n個のリストを生成する。
proc make_list {nelems arg block} {
	set retval [list]

	for {set i 0} {$i < $nelems} {incr i} {
		set $arg $i
		lappend retval [eval $block]
	}

	return $retval
}

foreach {i} [make_list 100 n {fizzbuzz [expr $n + 1]}] {
	puts $i
}

……ここまで書いておいてアレだが、やっぱり自重してTclらしい書き方に徹するべきだろう。

2012/05/29追記

お試しTk版。

#!/usr/bin/wish

# UI
frame .mbar -borderwidth 1 -relief raised
pack .mbar -fill x
menubutton .mbar.file -text "File" -menu .mbar.file.m
pack .mbar.file -side left
menu .mbar.file.m
.mbar.file.m add command -label "Exit" -command exit

text .results -background white
pack .results -expand yes -fill both

# Initialize
proc fizzbuzz {n} {
	set fizz [if {[expr $n % 3] == 0} {expr 1} else {expr 0}]
	set buzz [if {[expr $n % 5] == 0} {expr 2} else {expr 0}]

	switch [expr $fizz + $buzz] {
		1 {subst Fizz}
		2 {subst Buzz}
		3 {subst FizzBuzz}
		default {subst $n}
	}
}

for {set i 1} {$i <= 100} {incr i} {
	.results insert end [format "%s\n" [fizzbuzz $i]]
}
.results configure -state disabled

スクロールバーを追加したいけど失敗中。

2012/06/24追記

お試しTk完成版。

#!/usr/bin/wish

set auto_noexec 1

# UI
frame .menubar -borderwidth 1 -relief raised
pack .menubar -fill x
menubutton .menubar.file -text "File" -menu .menubar.file.m
pack .menubar.file -side left
menu .menubar.file.m -tearoff no
.menubar.file.m add command -label "Exit" -command exit

text .results -background white -wrap none -yscrollcommand {.vscroll set}
pack .results -expand yes -fill both -side left
scrollbar .vscroll -orient vertical -command {.results yview}
pack .vscroll -fill both -side left

# Initialize
proc fizzbuzz {n} {
	set fizz [if {[expr $n % 3] == 0} {expr 1} else {expr 0}]
	set buzz [if {[expr $n % 5] == 0} {expr 2} else {expr 0}]

	switch [expr $fizz + $buzz] {
		1 {subst Fizz}
		2 {subst Buzz}
		3 {subst FizzBuzz}
		default {subst $n}
	}
}

for {set i 1} {$i <= 100} {incr i} {
	.results insert end "[fizzbuzz $i]\n"
}
.results configure -state disabled
focus .results

ようやくスクロールバーの付け方が分かった。キーボードでのスクロールにも対応。

*1:元々、Unixアプリケーションの標準の拡張スクリプト言語としてデザインされたらしい。

*2:プログラマ視点での話。実際の処理系内部ではバイナリデータは可能な限りそのまま保持していて、文字列との変換の発生を極力抑えているらしい。

*3:多分シェルスクリプトっぽいのは元々の由来に起因する話だと思う。

*4:但し内部実装については不明。

*5:悪用かもしれない。

*6:正しくは文字列。

*7:もしかしたらあまり効率的でないかもしれない。