プログラミングを頑張る日記

プログラミングを勉強して、ハッカーになろう

Common Lispを頑張る(21)

本日もやっていきます「Land of Lisp」。
本日対象の辺りは、CLISP環境でしか使えないコマンドが
あるということで、下記のサイトを参考に環境に少し手を入れました。
CLISPとSBCLをSLIMEで選択的に使用しよう - suu-g's diary

それではやっていきます。

グラフの可視化

数学では、グラフとはエッジにより接続されたノードの集合だそうです。
そのようなグラフをコンスセルに格納したとしても、
それがわかりやすく見えるかどうかは別の話です。
それをオープンソースGraphvizでグラフの図にしてみよう、
というのが今回の話です。

例として、前のゲームで出てきたノードを図にするのですが…。
ちょっと試してみたら日本語でも動きましたが、
例に関数をあんまり使用せずにできちゃいそうで
勉強にならない感じがするので、参考書の例文でやってみます。

というわけで、今回グラフ化するノード&エッジは下記のものです。

CL-USER> (defparameter *wizard-nodes* '((living-room (you are in the living-room.
                                                      a wizard is snoring loudly on the couch.))
                                        (garden (you are in a beautiful garden.
                                                 there is a well in front of you.))
                                        (attic (you are in the attic. there 
                                                is a giant welding torch in the corner.))))
*WIZARD-NODES*
CL-USER> (defparameter *wizard-edges* '((living-room (garden west door)
                                                     (attic upstairs ladder))
                                        (garden (living-room east door))
                                        (attic (living-room downstairs ladder))))
*WIZARD-EDGES*
CL-USER>

これだけだとパット見ではどこがどこに繋がっているのか
わかりやすいものではないですね。

Graphviz

Graphvizはデータからグラフを作成してくれるツールです。
例として、下記のような内容でtest.dotを作り、

digraph{
  a->b;
}

下記のコマンドを打つと(terminalからの実行です)

neato -Tpng -O test.dot

グラフができます。

f:id:programcat:20181001152850p:plain
生成されたグラフ
便利ですね。
ツール自体の使い方はわかったので、Lispから
グラフを書けるライブラリを書いていくようです。

*ノードの識別子を変換
ノードをdotフォーマットにするのにまず必要なのは
識別子をdot識別子として有効な形にしてあげることですね。
DOTフォーマットのノードにはアルファベット、数字、アンスコしか
使えないそうなので(日本語も使えましたが)、
そのように変換する関数をまず作ってあげます。

CL-USER> (defun dot-name (exp)
           (substitute-if #\_ (complement #'alphanumericp) (prin1-to-string exp)))

DOT-NAME
CL-USER> (dot-name 'living-room)
"LIVING_ROOM"
CL-USER>

うむむ、まず知りたいのはsubstitute-ifですね。
説明によると、与えられたテスト関数の結果によって値を置き換える変数だとか。
第一引数が置き換え先の文字、第二引数がテスト関数、第三が対象の文字列ですね。
第一引数はcharacterと明示して渡しているということでしょうか。
第三引数はdot-nameの引数を文字列に変換していますね。
それでは第二引数です。
complementに渡されているalphanumericpはpで終わっているので
真偽値を返す関数で、名前からしてアルファベットか数字なら真になるんでしょう。
そしてcomplementは、真偽値を反転させる関数だそうです。

まとめると、dot-nameは引数で受け取ったものをまず文字列にして、
その中からアルファベットでも数字でもないものを判別して、
"_"に置き換えて返してくる関数ですね。

ノードにラベルを付ける

ノードの識別子の変換はできるようになりました。
ノードのそばに置かれるラベルを作る関数だそう。
ラベルにはノード名と、それに紐づくalistのデータを表示するように、
そしてあんまりテキストを詰め込みすぎないように。
という感じで作られる関数が下記のものです。

CL-USER> (defun dot-label (exp)
           (if exp
               (let ((s (write-to-string exp :pretty nil)))
                 (if (> (length s) *max-label-length*)
                     (concatenate 'string (subseq s 0 (- *max-label-length* 3)) "...")
                     s))
               ""))
DOT-LABEL
CL-USER> (dot-label (cadar *wizard-nodes*))
"(YOU ARE IN THE LIVING-ROOM..."
CL-USER>

ふむふむ。dot-labelも一瞬面食らってしまいましたが、いけます!
まず、引数をexpに束縛して、expがnilならもう空文字列を返します。
nilでなければ、letを使いsにexpを文字列にしたものを入れます。
:prettyキーワードでnilを渡すのは、勝手に改行したりタブを
入れさせないためだそうです。
そして引数を文字列にしたものが*max-label-length*より長ければ
subseqを使って指定の長さ-3まで切り詰め、それを"..."と
concatenateして、最後に加工したsが戻り値になるようにして終わりです。

ノードのDOT情報生成

ノードのalistを撮って、その情報をDOTのフォーマットで
生成する関数は下記のようになるようです。

CL-USER> (defun nodes->dot (nodes)
           (mapc (lambda (node)
                 (fresh-line)
                 (princ (dot-name (car node)))
                 (princ "[label=\"")
                 (princ (dot-label node))
                 (princ "\"];"))
                 nodes))
NODE->DOT
CL-USER> (nodes->dot *wizard-nodes*)
LIVING_ROOM[label="(LIVING-ROOM (YOU ARE IN TH..."];
GARDEN[label="(GARDEN (YOU ARE IN A BEAUT..."];
ATTIC[label="(ATTIC (YOU ARE IN THE ATTI..."];
((LIVING-ROOM
  (YOU ARE IN THE LIVING-ROOM. A WIZARD IS SNORING LOUDLY ON THE COUCH.))
 (GARDEN (YOU ARE IN A BEAUTIFUL GARDEN. THERE IS A WELL IN FRONT OF YOU.))
 (ATTIC (YOU ARE IN THE ATTIC. THERE IS A GIANT WELDING TORCH IN THE CORNER.)))
CL-USER>

ふむふむ。こういった書式がdotファイルに書けるのでしょう。
mapcはmapcarの変種で、結果のリストを返さない分mapcarより早いそうです。

これらは結局ファイルに書かなきゃいけない情報なのに、
何故コンソールに書かれるのかというと、REPLで関数を実行して
結果をすぐ見られるから、というのが一つの理由だとか。

また、このよう戻り値ではなくREPLに出力する情報だけを使うことを
「関数の副作用だけを使う」と言うそうです。

エッジを変換する

CL-USER> (defun edges->dot (edges)
           (mapc (lambda (node)
                   (mapc (lambda (edge)
                           (fresh-line)
                           (princ (dot-name (car node)))
                         (princ "->")
                         (princ (dot-name (car edge)))
                         (princ "[label=\"")
                         (princ (dot-label (cdr edge)))
                         (princ "\"];"))
                   (cdr node)))
                 edges))

EDGES->DOT
CL-USER> (edges->dot *wizard-edges*)
LIVING_ROOM->GARDEN[label="(WEST DOOR)"];
LIVING_ROOM->ATTIC[label="(UPSTAIRS LADDER)"];
GARDEN->LIVING_ROOM[label="(EAST DOOR)"];
ATTIC->LIVING_ROOM[label="(DOWNSTAIRS LADDER)"];
((LIVING-ROOM (GARDEN WEST DOOR) (ATTIC UPSTAIRS LADDER))
 (GARDEN (LIVING-ROOM EAST DOOR)) (ATTIC (LIVING-ROOM DOWNSTAIRS LADDER)))
CL-USER>

当然今度はエッジの変換です。先程の応用ですが、少し複雑。
①edges-dotがエッジを受け取る。
②要素を一つ取り出し(mapc)、ラムダ式にnodeとして渡す。
③更にcar要素を取り出し、ラムダ式にedgeとして渡す。
④色々形式を合わせるための処理とか。

(mapc (lambda ~))が入れ子になっているのがちょっと理解を妨げました。
とはいえそれだけの関数ですね。もはやそんなに大した敵ではありません。

dotデータを完成させる

必要なものを付け足し、処理をまとめます。

CL-USER> (defun graph->dot (nodes edges)
           (princ "digraph{")
           (nodes->dot nodes)
           (edges->dot edges)
           (princ "}"))
GRAPH->DOT
CL-USER> (graph->dot *wizard-nodes* *wizard-edges*)
digraph{
LIVING_ROOM[label="(LIVING-ROOM (YOU ARE IN TH..."];
GARDEN[label="(GARDEN (YOU ARE IN A BEAUT..."];
ATTIC[label="(ATTIC (YOU ARE IN THE ATTI..."];
LIVING_ROOM->GARDEN[label="(WEST DOOR)"];
LIVING_ROOM->ATTIC[label="(UPSTAIRS LADDER)"];
GARDEN->LIVING_ROOM[label="(EAST DOOR)"];
ATTIC->LIVING_ROOM[label="(DOWNSTAIRS LADDER)"];}
"}"
CL-USER>

よさそうです。

dotファイルを画像にする

あとは生成したdot形式のデータをファイルに出力し、
shellからdotコマンドを起動すればいいだけです。

CL-USER> (defun dot->png (fname thunk)
           (with-open-file (*standard-output*
                            fname
                            :direction :output
                            :if-exists :supersede)
             (funcall thunk))
           (ext:shell (concatenate 'string "dot -Tpng -O " fname)))
DOT->PNG
CL-USER>

むむむ。ファイル出力が来ましたね。
with-file-openで*standard-output*をfnameに書き込む、
それは:direction :outputで指定していそうです。
入力ならきっと:inputが:outputの代わりに来るのでしょう。

if-exists
supersedeはもし指定したファイル名が存在するなら

上書きしちゃえってことですね。
(funcall thunk)が*standard-output*に出力され、
それらがファイルに書き込まれるのでしょう。
最後は、ext:shellはきっと引数をshellにぶち込めってこと。
引数があからさまに最初にやった画像ファイル生成のやつになるので。
ふふふ、やることが決まっているので当たっている自信があります。
解説を見ていきます。

ふむむ、中から直接graph->dotを呼ばずに(funcall thunk)と
しているのは、再利用可能性のためだそうです。

サンク

引数を取らない関数は正式には零項(nullary)関数というそう。
今すぐには実行したくない計算を包んでおくのに零項関数をよく使うらしいです。
そしてそのように使われる零項関数をサンクやサスペンションと呼ぶそうです。

今の例でいうと、dot->pngにgraph->dotの戻り値を渡すというわけには
いかないので、dot->pngをサンクとして渡し必要な時に呼んでもらうと。

プログラムからテキスト形式のデータを生成するのはよくあることなので、
このテクニックはよく使われるそうです。

with-open-file

このファイル操作の関数を理解するために使ってみます。

CL-USER> (defun test-file-out (filename stream string)
           (with-open-file (stream filename :direction :output :if-exists :supersede)
             (princ string stream)))
TEST-FILE-OUT
CL-USER> (test-file-out "/Users/user/Desktop/Lisp/test.txt" 'my-stream "hello!")
"hello!"
CL-USER>

指定した場所に、"hello!"とだけ書かれたファイルが有りました。
それではちょっと改造します。

CL-USER> (defun test-file-out (filename stream string)
           (with-open-file (stream filename :direction :output :if-exists :supersede)
             (princ string stream)
             (princ (concatenate 'string string "2"))))
TEST-FILE-OUT
CL-USER> (test-file-out "/Users/user/Desktop/Lisp/test.txt" 'my-stream "hello!")
hello!2
"hello!2"
CL-USER>

戻り値は"hello!2"でありますが、ファイルの中身は相変わらず"hello!"です。
streamを指定していないからでしょう。
最後にもう一回だけ。

CL-USER> (defun test-file-out (filename stream string)
           (with-open-file (stream filename :direction :output :if-exists :supersede)
             (princ string)))
TEST-FILE-OUT
CL-USER> (test-file-out "/Users/user/Desktop/Lisp/test.txt" *standard-output* "hello!")
hello!
"hello!"
CL-USER>

空ファイルができました。うーん"hello!"が出力されると思ったのですが。
解説を読みます。

with-open-fileはストリームを作ります。
そしてprinc等の出力関数は、省略可能な引数としてストリームを受け取ります。
受け取れば、コンソールではなくそのストリームオブジェクトへ出力します。
with-open-fileで作ったストリームを束縛が有効な範囲で
出力関数に渡せば、指定したファイルへの出力にできるってことですね。

dot->png内ではそれとは違った方法でファイルに書き込んでいます。
ストリームとして宣言しているのは*standard-output*です。
これはどうやらダイナミック変数であって、出力関数の
デフォルトの出力ストリームだそうです。

うむむ、何故先程3つ目の関数が空ファイルを作ってしまったのか。

CL-USER> (defun test-file-out (filename string)
           (with-open-file (*standard-output* filename :direction :output :if-exists :supersede)
             (princ string)))
TEST-FILE-OUT
CL-USER> (test-file-out "/Users/user/Desktop/Lisp/test.txt" "hello!")
"hello!"
CL-USER>

うーん、これならいいのか。なぜだかわかりません。
ダイナミック変数を上書きするにも色々制限があるのでしょうか。

…ああ、違うか。変数の中身を気にしているのではなく、変数名だけを
気にするべきなんだから、どんなに頑張ったところで
束縛する変数名はさっきまでのでは"filename"でしたもんね。
まだまだダイナミック変数理解できてないなあ。

とはいえwith-open-fileのここでの使われ方はわかりました。
次へ行きます。

そして画像出力

全てのコードをまとめて、画像を出してくれる関数です。

CL-USER> (defun graph->png (fname nodes edges)
           (dot->png fname
                     (lambda ()
                       (graph->dot nodes edges))))
GRAPH->PNG
CL-USER> (graph->png "/Users/user/Desktop/Lisp/wizard.dot" *wizard-nodes* *wizard-edges*)
NIL
CL-USER>

f:id:programcat:20181001213924p:plain
いやあ、長かったですが終わりました。
次のページに無向グラフをつくる、とか書いてあるのですが
ちょっと疲れたのでこっそりやっておきます。

明日は次の章に入ろうと思います。
それではおやすみなさい。