エンジニアのソフトウェア的愛情

または私は如何にして心配するのを止めてプログラムを・愛する・ようになったか

Prologとステートマシン

相変わらず「どう書く」から。
今回は第3回の参考問題と本題から。

Prologで書くステートマシン

野球のボールカウントは、現在の状態があって、入力がはいると次の状態に変化する、ということなのでステートマシンとしてあらわすことができると直感的にはわかると思います。

今回、Prologで試行錯誤しているうちに、次のようなパタンでステートマシンをあらわすことができることがわかってきました。

rule(入力列, 出力列) :- rule(入力列, 初期状態, 出力列).

rule([], _, []). % 終了条件
rule([ 今回の入力 | 後続の入力列], 現在の状態, [ 今回の出力 | 後続の出力列 ]) :-
    次の状態の演算,
    今回の出力の演算,
    rule(後続の入力列, 次の状態, 後続の出力列).

ここでは同じruleという名前を使っていますが、引数が2つのものと3つのものを定義しています。Prologでは引数の数(アリティと言います)が違うと名前が同じでも別の定義とされます。これらを区別するためにrule/2rule/3といった書き方をします(Erlangも同じ書き方をします。Prologを学び始めて知ったのですが、ErlangPrologの影響を受けた言語なのだそうです)。

rule/2は入力列と出力列を引数にとり、その2つに初期状態を加えてrule/3を呼び出します。
rule/3は今回の入力と現在の状態から、次の状態と今回の出力を演算します。以降終了条件にマッチするまで再帰的に処理を続けます。


ちなみに。これをHaskellに翻訳すると次のような感じになるかと思います。

rule 入力列 = rule' 入力列 初期状態

rule' [] _ = []
rule' ( 今回の入力 : 後続の入力列 ) 現在の状態 =
    let 次の状態の演算
        今回の出力の演算
    in  今回の出力:(rule 後続の入力列 次の状態)


これらをふまえて。
野球のボールカウントを、こう書いてみました。「今回の出力」が「次の状態」の一部になっているので「次の状態の演算」と「今回の出力の演算」が1つの演算ですんでいます。


以下、コード。

rule(Xs, Ys) :- rule(Xs, [0,0,0], Ys).

rule([], _, []).
rule([0's|Xs], [ 2, 2, _], [[ 0, 0, 0]|Ys]) :-               rule(Xs, [ 0, 0, 0], Ys), !. % strike
rule([0's|Xs], [O1, 2, _], [[O2, 0, 0]|Ys]) :- O2 is O1 + 1, rule(Xs, [O2, 0, 0], Ys), !. % strike
rule([0's|Xs], [O1,S1,B1], [[O1,S2,B1]|Ys]) :- S2 is S1 + 1, rule(Xs, [O1,S2,B1], Ys), !. % strike
rule([0'b|Xs], [O1, _, 3], [[O1, 0, 0]|Ys]) :-               rule(Xs, [O1, 0, 0], Ys), !. % ball
rule([0'b|Xs], [O1,S1,B1], [[O1,S1,B2]|Ys]) :- B2 is B1 + 1, rule(Xs, [O1,S1,B2], Ys), !. % ball
rule([0'f|Xs], [O1, 0,B1], [[O1, 1,B1]|Ys]) :-               rule(Xs, [O1, 1,B1], Ys), !. % foul
rule([0'f|Xs], [O1, 1,B1], [[O1, 2,B1]|Ys]) :-               rule(Xs, [O1, 2,B1], Ys), !. % foul
rule([0'f|Xs], [O1, 2,B1], [[O1, 2,B1]|Ys]) :-               rule(Xs, [O1, 2,B1], Ys), !. % foul
rule([0'h|Xs], [O1, _, _], [[O1, 0, 0]|Ys]) :-               rule(Xs, [O1, 0, 0], Ys), !. % hit
rule([0'p|Xs], [ 2, _, _], [[ 0, 0, 0]|Ys]) :-               rule(Xs, [ 0, 0, 0], Ys), !. % pitcher fly
rule([0'p|Xs], [O1, _, _], [[O2, 0, 0]|Ys]) :- O2 is O1 + 1, rule(Xs, [O2, 0, 0], Ys), !. % pitcher fly

format_count([ [Out, Strike, Ball] ], S)   :- format_to_chars("~d~d~d", [Out, Strike, Ball], S), !.
format_count([ [Out, Strike, Ball]|Xs], S) :- format_count(Xs, S0), format_to_chars("~d~d~d,~s", [Out, Strike, Ball, S0], S), !.

test(Input, Expected) :-
    rule(Input, Y),
    format_count(Y, Actual),
    format("~s~n", [Actual]),
    Actual == Expected.

tests :-
    test("s",               "010"),
    test("sss",             "010,020,100"),
    test("bbbb",            "001,002,003,000"),
    test("ssbbbb",          "010,020,021,022,023,000"),
    test("hsbhfhbh",        "000,010,011,000,010,000,001,000"),
    test("psbpfpbp",        "100,110,111,200,210,000,001,100"),
    test("ppp",             "100,200,000"),
    test("ffffs",           "010,020,020,020,100"),
    test("ssspfffs",        "010,020,100,200,210,220,220,000"),
    test("bbbsfbppp",       "001,002,003,013,023,000,100,200,000"),
    test("sssbbbbsbhsbppp", "010,020,100,101,102,103,100,110,111,100,110,111,200,000,100"),
    test("ssffpffssp",      "010,020,020,020,100,110,120,200,210,000").


実行結果。

$ swipl -s sample3.pl -g tests -t halt
010
010,020,100
001,002,003,000
010,020,021,022,023,000
000,010,011,000,010,000,001,000
100,110,111,200,210,000,001,100
100,200,000
010,020,020,020,100
010,020,100,200,210,220,220,000
001,002,003,013,023,000,100,200,000
010,020,100,101,102,103,100,110,111,100,110,111,200,000,100
010,020,020,020,100,110,120,200,210,000

右カーブは逆からたどると左カーブ 〜 もっとPrologらしく。

この勢いで第3回の本題も解いてみました。

問題再掲。


以下、コード。ちなみに「0'A」という表記は「A」という文字をあらわす表記法です。今回しらべてみて知りました。正直、とても見にくいです。

route(Xs, [0'A|Ys]) :- route(Xs, [0'B,0'A], Ys).

route([], _, []).

route([0'r|Xs], [0'A,0'B], [0'E|Ys]) :- route(Xs, [0'B,0'E], Ys).
route([0'r|Xs], [0'A,0'C], [0'B|Ys]) :- route(Xs, [0'C,0'B], Ys).
route([0'r|Xs], [0'A,0'D], [0'F|Ys]) :- route(Xs, [0'D,0'F], Ys).
route([0'r|Xs], [0'B,0'A], [0'C|Ys]) :- route(Xs, [0'A,0'C], Ys).
route([0'r|Xs], [0'B,0'C], [0'F|Ys]) :- route(Xs, [0'C,0'F], Ys).
route([0'r|Xs], [0'B,0'E], [0'D|Ys]) :- route(Xs, [0'E,0'D], Ys).
route([0'r|Xs], [0'C,0'A], [0'D|Ys]) :- route(Xs, [0'A,0'D], Ys).
route([0'r|Xs], [0'C,0'B], [0'A|Ys]) :- route(Xs, [0'B,0'A], Ys).
route([0'r|Xs], [0'C,0'F], [0'E|Ys]) :- route(Xs, [0'F,0'E], Ys).
route([0'r|Xs], [0'D,0'A], [0'B|Ys]) :- route(Xs, [0'A,0'B], Ys).
route([0'r|Xs], [0'D,0'E], [0'F|Ys]) :- route(Xs, [0'E,0'F], Ys).
route([0'r|Xs], [0'D,0'F], [0'C|Ys]) :- route(Xs, [0'F,0'C], Ys).
route([0'r|Xs], [0'E,0'B], [0'C|Ys]) :- route(Xs, [0'B,0'C], Ys).
route([0'r|Xs], [0'E,0'D], [0'A|Ys]) :- route(Xs, [0'D,0'A], Ys).
route([0'r|Xs], [0'E,0'F], [0'D|Ys]) :- route(Xs, [0'F,0'D], Ys).
route([0'r|Xs], [0'F,0'C], [0'A|Ys]) :- route(Xs, [0'C,0'A], Ys).
route([0'r|Xs], [0'F,0'D], [0'E|Ys]) :- route(Xs, [0'D,0'E], Ys).
route([0'r|Xs], [0'F,0'E], [0'B|Ys]) :- route(Xs, [0'E,0'B], Ys).

route([0'l|Xs], [0'A,0'B], [0'C|Ys]) :- route(Xs, [0'B,0'C], Ys).
route([0'l|Xs], [0'A,0'C], [0'F|Ys]) :- route(Xs, [0'C,0'F], Ys).
route([0'l|Xs], [0'A,0'D], [0'E|Ys]) :- route(Xs, [0'D,0'E], Ys).
route([0'l|Xs], [0'B,0'A], [0'D|Ys]) :- route(Xs, [0'A,0'D], Ys).
route([0'l|Xs], [0'B,0'C], [0'A|Ys]) :- route(Xs, [0'C,0'A], Ys).
route([0'l|Xs], [0'B,0'E], [0'F|Ys]) :- route(Xs, [0'E,0'F], Ys).
route([0'l|Xs], [0'C,0'A], [0'B|Ys]) :- route(Xs, [0'A,0'B], Ys).
route([0'l|Xs], [0'C,0'B], [0'E|Ys]) :- route(Xs, [0'B,0'E], Ys).
route([0'l|Xs], [0'C,0'F], [0'D|Ys]) :- route(Xs, [0'F,0'D], Ys).
route([0'l|Xs], [0'D,0'A], [0'C|Ys]) :- route(Xs, [0'A,0'C], Ys).
route([0'l|Xs], [0'D,0'E], [0'B|Ys]) :- route(Xs, [0'E,0'B], Ys).
route([0'l|Xs], [0'D,0'F], [0'E|Ys]) :- route(Xs, [0'F,0'E], Ys).
route([0'l|Xs], [0'E,0'B], [0'A|Ys]) :- route(Xs, [0'B,0'A], Ys).
route([0'l|Xs], [0'E,0'D], [0'F|Ys]) :- route(Xs, [0'D,0'F], Ys).
route([0'l|Xs], [0'E,0'F], [0'C|Ys]) :- route(Xs, [0'F,0'C], Ys).
route([0'l|Xs], [0'F,0'C], [0'B|Ys]) :- route(Xs, [0'C,0'B], Ys).
route([0'l|Xs], [0'F,0'D], [0'A|Ys]) :- route(Xs, [0'D,0'A], Ys).
route([0'l|Xs], [0'F,0'E], [0'D|Ys]) :- route(Xs, [0'E,0'D], Ys).

route([0'b|Xs], [Y1,Y2], [Y1|Ys]) :- route(Xs, [Y2,Y1], Ys).

test(Input, Expected) :- route(Input, Actual), Actual == Expected, format("~s~n", [Actual]).

% テストパタン略


今回のコードでは、「今回の入力」と「現在の状態」から自動的に「今回の出力」と「次の状態」が求まるので演算はありません。

これで一応動くのですが、書き終わった直後からなんとも言えない違和感が。なにか別の言語で書いたコードの劣化コピーのような印象が拭えません。


問題を、もういちど、じーっと見つめてみました。
問題はグラフ上の経路を求めるものです。グラフと言えばPrologでは事実として定義することができるはずです。今回のコードではそういったものがありません。
グラフを事実で定義したらどうなるか…?


考えた結果、出てきたのがこれでした。

right(0'A, 0'B, 0'E).

これはA→Bと進んで右の経路を選択したばあいEに移動する、という事実をあらわしています。
ここで視点を逆転させて、E→Bと進むことを考えます。するとこの定義はE→Bと進んで左の経路を選択したばあいAに移動する、という事実もあらわしていることがわかります。

つまり。右に向かう経路だけを定義すれば、左に向かう経路も自動的に定義されることになります。
これで経路の構造をあらわす事実と、経路を探索する手続きとを分離して定義することができるようになりました。


以下、コード。38あったrouteの定義を4つにまで減らすことができました。

right(0'A, 0'B, 0'E).
right(0'A, 0'C, 0'B).
right(0'A, 0'D, 0'F).
right(0'B, 0'A, 0'C).
right(0'B, 0'C, 0'F).
right(0'B, 0'E, 0'D).
right(0'C, 0'A, 0'D).
right(0'C, 0'B, 0'A).
right(0'C, 0'F, 0'E).
right(0'D, 0'A, 0'B).
right(0'D, 0'E, 0'F).
right(0'D, 0'F, 0'C).
right(0'E, 0'B, 0'C).
right(0'E, 0'D, 0'A).
right(0'E, 0'F, 0'D).
right(0'F, 0'C, 0'A).
right(0'F, 0'D, 0'E).
right(0'F, 0'E, 0'B).

route(Xs, [0'A|Ys]) :- route(Xs, [0'B, 0'A], Ys).

route([]      , _      , []     ).
route([0'r|Xs], [Y1,Y2], [Y3|Ys]) :- right(Y1, Y2, Y3), route(Xs, [Y2,Y3], Ys).
route([0'l|Xs], [Y1,Y2], [Y3|Ys]) :- right(Y3, Y2, Y1), route(Xs, [Y2,Y3], Ys).
route([0'b|Xs], [Y1,Y2], [Y1|Ys]) :-                    route(Xs, [Y2,Y1], Ys).

test(Input, Expected) :-
    route(Input, Actual),
    format("~s~n", [Actual]),
    Actual == Expected.

tests :-
    test("b",               "AB"),
	test("l",               "AD"),
	test("r",               "AC"),
	test("bbb",             "ABAB"),
	test("rrr",             "ACBA"),
	test("blll",            "ABCAB"),
	test("llll",            "ADEBA"),
	test("rbrl",            "ACADE"),
	test("brrrr",           "ABEDAB"),
	test("llrrr",           "ADEFDE"),
	test("lrlll",           "ADFEDF"),
	test("lrrrr",           "ADFCAD"),
	test("rllll",           "ACFDAC"),
	test("blrrrr",          "ABCFEBC"),
	test("brllll",          "ABEFCBE"),
	test("bbbrrlrl",        "ABABEDFCB"),
	test("rbllrrrr",        "ACABCFEBC"),
	test("lbrlrrblr",       "ADABCFEFCA"),
	test("rlbrrrrbl",       "ACFCADFCFD"),
	test("bllrlrbrrb",      "ABCADEFEBCB"),
	test("rllrllllbb",      "ACFDEBADEDE"),
	test("blblrlrrlbr",     "ABCBEDFCABAC"),
	test("lrlrrrrrbrb",     "ADFEBCFEBEDE"),
	test("rblllrlrrlrr",    "ACABCADEFDABE"),
	test("rbrrlrblrllb",    "ACADFEBEFDACA"),
	test("lrrrlrllrrllr",   "ADFCABEFCADEBC"),
	test("rrlblllrrlrrb",   "ACBEBADEFDABEB"),
	test("brbllrrbbrlrll",  "ABEBADFCFCABEFC"),
	test("rrrbbrlbrlblrb",  "ACBABACFCABADFD"),
	test("lllllllllllblrr", "ADEBADEBADEBEFDE"),
	test("llllllrllrlbrrr", "ADEBADEFCBADABED").


実行結果。

$ swipl -s ord3-2.pl -g tests -t halt
AB
AD
AC
ABAB
ACBA
ABCAB
ADEBA
ACADE
ABEDAB
ADEFDE
ADFEDF
ADFCAD
ACFDAC
ABCFEBC
ABEFCBE
ABABEDFCB
ACABCFEBC
ADABCFEFCA
ACFCADFCFD
ABCADEFEBCB
ACFDEBADEDE
ABCBEDFCABAC
ADFEBCFEBEDE
ACABCADEFDABE
ACADFEBEFDACA
ADFCABEFCADEBC
ACBEBADEFDABEB
ABEBADFCFCABEFC
ACBABACFCABADFD
ADEBADEBADEBEFDE
ADEBADEFCBADABED