目的
覆面算です。
SEND+MORE=MONEY
が有名ですが、
SEND+ME+MORE=MONEY
という問題も昔見かけたことがある気がしたので、いろいろなお題を解くことができるプログラムを作ることにしました。
思いつくままに処理を書き連ねていくとそれらしいプログラムができたので、どうやって作っていったかを記録しておきます。
実装
パズルといえばやはり Prolog です。
与えられた任意のお題に対して答えを出すプログラムにしたいとも思いました。
そのためにはお題のパーサも作る必要があります。パーサといえばやっぱり Prolog です。
Prolog 以外で書く理由がありません。
お題のパース処理
まずは与えられるお題を解釈するパーサを作成します。
SEND+MORE=MONEY
のような文字列としてお題が与えられたら、
['D', 'N', 'E', 'S'] + ['E', 'R', 'O', 'M'] = ['Y', 'E', 'N', 'O', 'M']
の形に変換して返す述語です。
敢えて元のお題と逆順にしているのは、一の桁から順に上位の桁に向かって加算をしていく処理をリスト先頭からの処理として書けるようにするためです。
expr(X = Y) --> expr_add(X), [=], expr_rvar(Y).
expr(R) --> expr_rvar(R).
expr_add(X + Y) --> expr_rvar(X), [+], expr_add(Y).
expr_add(X) --> expr_rvar(X).
expr_rvar(R) --> expr_var(V), { reverse(V, R) }.
expr_var([C|Cs]) --> expr_alpha(C), expr_var(Cs).
expr_var([]) --> [].
expr_alpha(C) --> [C], { char_type(C, alpha) }.
書いた述語は以下のようにテストできます。
?- string_chars('SEND+ME+MORE=MONEY', Qs), phrase(expr(Ps), Qs).
Qs = ['S', 'E', 'N', 'D', +, 'M', 'E', +, 'M'|...],
Ps = (['D', 'N', 'E', 'S']+(['E', 'M']+['E', 'R', 'O', 'M'])=['Y', 'E', 'N', 'O', 'M']) ;
false.
お題に含まれる変数の一覧を得る
お題にある文字それぞれが、数字が入る変数です。
述語 extract_vars/2 として、与えられた項に出現する文字をリスト化して返す処理を作りました。
extract_vars([], []).
extract_vars(X=Y, Vars) :-
extract_vars(X, Vars1), extract_vars(Y, Vars2), append(Vars1, Vars2, Vars).
extract_vars(X+Y, Vars) :-
extract_vars(X, Vars1), extract_vars(Y, Vars2), append(Vars1, Vars2, Vars).
extract_vars(X-Y, Vars) :-
extract_vars(X, Vars1), extract_vars(Y, Vars2), append(Vars1, Vars2, Vars).
extract_vars([C|Cs], [C|Vars]) :-
extract_vars(Cs, Vars).
extract_vars/2 は、ただ単に見つかった順にリスト化して返しているだけなので重複も含まれます。重複した文字（変数名）を削除してユニークな変数名だけのリストにする述語 distinct_list を作ります（いかにもライブラリにありそうな処理内容なのですが、Prolog 初心者なのでみつけられませんでした）。
distinct_list(Xs, Ys) :- distinct_list(Xs, Ys, []).
distinct_list([], Ys, Ys).
distinct_list([X|Xs], Ys, As) :-
( member(X, As) -> distinct_list(Xs, Ys, As)
; distinct_list(Xs, Ys, [X|As])
).
extract_vars/2 と distinct_list/2 のワンセットでお題に含まれる変数名一覧を重複なしで得る処理が実現できます。
?- string_chars('SEND+ME+MORE=MONEY', Qs), phrase(expr(Ps), Qs), extract_vars(Ps, Vars), distinct_list(Vars, UniqVars).
Qs = ['S', 'E', 'N', 'D', +, 'M', 'E', +, 'M'|...],
Ps = (['D', 'N', 'E', 'S']+(['E', 'M']+['E', 'R', 'O', 'M'])=['Y', 'E', 'N', 'O', 'M']),
Vars = ['D', 'N', 'E', 'S', 'E', 'M', 'E', 'R', 'O'|...],
UniqVars = ['Y', 'O', 'R', 'M', 'S', 'E', 'N', 'D'] ;
false.
(Vars に重複を含む変数名の全リストが、Uniqvars に重複を除いた変数名の一覧が得られている）
変数の値を格納する領域を作る
変数名一覧が得られたので、それらの変数に対応する値を格納する領域を作ります。
具体的には、与えられた変数名リストに対して、変数名と値が入る領域（Prolog 変数）のペアのリストを返す述語 generate_var_value_pair/2 を作ります。
generate_var_value_pair([], []).
generate_var_value_pair([Var|Vars], [[Var|_]|VPairs]) :-
generate_var_value_pair(Vars,VPairs).
変数名とその変数の値を格納する領域が定まったので、お題の項に含まれる変数名を対応する Prolog 変数に置き換える処理 rewrite_goal/2 を作りました。
rewrite_goals(_, [], []).
rewrite_goals(VPairs, X=Y, VX=VY) :-
rewrite_goals(VPairs, X, VX),
rewrite_goals(VPairs, Y, VY).
rewrite_goals(VPairs, X+Y, VX+VY) :-
rewrite_goals(VPairs, X, VX),
rewrite_goals(VPairs, Y, VY).
rewrite_goals(VPairs, [X|Xs], [VX|VXs]) :-
rewrite_var(VPairs, X, VX),
rewrite_goals(VPairs, Xs, VXs).
rewrite_var([], X, X).
rewrite_var([[Var|Val]|VPairs], X, VX) :-
( Var = X -> VX = var(Var, Val)
; rewrite_var(VPairs, X, VX)
).
ここで、元の変数名の場所をそのまま Prolog 変数に置き換えるのでなく、var(変数名, 変数) にしています。これは、後の処理でそれぞれの変数に重複しない数を割り当てるためです。
サブゴール分割
この項をそのまま Prolog プログラムとして実行できればよいのですが、さすがにそうはいかないのでもっと具体的なサブゴールに分けることを考えます。
それぞれの桁について一つの数字同士の足し算レベルにまで分解していきます。
まず、全体は (足し算を含む部分) = (数値） という形の式です。これをサブゴールのリストに分解して返す述語 build_goals/2 を作ります。
build_goals(A+B=D, Goals) :-
build_goals(B=B0, AddGoalsB),
build_add_goals(A+B0=D, AddGoalsA),
append(AddGoalsB, AddGoalsA, Goals).
build_goals([]=[], []).
build_goals([X|Xs]=[Y|Ys], [assign(X, Y)|Goals]) :-
build_goals(Xs=Ys, Goals).
足し算を含む部分も、A + (足し算を含む部分) の形に再帰的に A+B の形の足し算にまで分割していきます。
A+B の形の足し算はさらに一桁ずつの
(繰り上がりの値) + (変数) + (変数) → (加算結果の十の位) と(加算結果の一の位)
にまで分解して、これらをサブゴールとして返します。
build_add_goals(Expr, Goals) :-
build_add_goals(var(_, 0), Expr, Goals1),
non_zero_goals(Expr, Goals2),
append(Goals1, Goals2, Goals).
build_add_goals(C, [X|Xs]+[Y|Ys]=[Z|Zs],
[carry(C, X, Y, C2, Z)|Goals])
:- build_add_goals(C2, Xs+Ys=Zs, Goals).
build_add_goals(C, []+[Y|Ys]=[Z|Zs],
[carry(C, var(_, 0), Y, C2, Z)|Goals])
:- build_add_goals(C2, []+Ys=Zs, Goals).
build_add_goals(C, [X|Xs]+[]=[Z|Zs],
[carry(C, X, var(_, 0), C2, Z)|Goals])
:- build_add_goals(C2, Xs+[]=Zs, Goals).
build_add_goals(C, []+[]=[A], [assign(C, A)]).
build_add_goals(var(_, 0), []+[]=[], []).
var(_, 0) は、値 0 の自由変数を意味します。ここで「自由変数」と言っているのは、お題に与えられた重複を許さない変数とは異なる、重複が許される任意の値を持つ変数という意味です。
A + B + C を B + C = BC と A + BC のサブゴールに分割する、といった際の途中結果 BC の置き場所などとしても自由変数を使用します。
サブゴールの実装
繰り上がりを含む加算
(繰り上がりの値) + (一桁の数) + (一桁の数) → (加算結果の十の位) と(加算結果の一の位)
を実行する述語が carry/6 です。
最後の引数は変数に値が未割り当てのときに未使用の（Free な）数の一つを選んで変数に割り付ける処理のためのものです。
未使用の値から選んで割り当てるようにしないと、「全部の数字が 0 です」などというつまらない答えを返してしまうことになります。
carry(A, B, C, D, E, Free -> Free5) :-
num(A, Free -> Free1),
num(B, Free1 -> Free2),
num(C, Free2 -> Free3),
A = var(_, Aval),
B = var(_, Bval),
C = var(_, Cval),
X is Aval + Bval + Cval, X0 is X mod 10, X1 is div(X, 10),
assign(var(_, X1), D, Free3 -> Free4),
assign(var(_, X0), E, Free4 -> Free5).
num(var(Var, Val), Free -> Free2) :-
( number(Val) -> Free = Free2
; var(Var) -> num(Val), Free = Free2
; select(Val, Free, Free2)
).
num(1). num(2). num(3). num(4). num(5).
num(6). num(7). num(8). num(9). num(0).
assign(var(VarX, ValX), var(VarY, ValY), Free -> Free2) :-
( var(VarX), var(VarY) -> ValX = ValY, Free = Free2
; nonvar(VarY), var(ValY) -> select(ValX, Free, Free2), ValX = ValY
; ValX = ValY, Free = Free2
), VarX = VarY.
num/2 は、carry/6 に入力として与えられる変数の値が未確定だった場合に確定させるための述語です。
引数に与えられる var/2 を見て、自由変数なら適当な 0 から 9 までの適当な数字を割り当てます。
?- num(var(_, X), [1, 2] -> V).
X = 1,
V = [1, 2] ;
X = 2,
V = [1, 2] ;
X = 3,
V = [1, 2] ;
X = 4,
V = [1, 2] ;
X = 5,
V = [1, 2] ;
X = 6,
V = [1, 2] ;
X = 7,
V = [1, 2] ;
X = 8,
V = [1, 2] ;
X = 9,
V = [1, 2] ;
X = 0,
V = [1, 2].
引数に与えられるのがお題に与えられた変数なら、まだ使っていない数字から選んで割り当てます。
?- num(var('A', X), [1, 2] -> V).
X = 1,
V = [2] ;
X = 2,
V = [1] ;
false.
assign/3 も似たような処理ですが、加算結果などで与えられた数字などを元に自由変数あるいはお題に与えられた変数に代入します。
代入先がお題に与えられた変数で、かつ値が未確定のとき、未使用の数字なら割り当て可能です。
?- assign(var(_, 1), var('A', X), [1, 2] -> V).
X = 1,
V = [2] ;
false.
?- assign(var(_, 2), var('A', X), [1, 2] -> V).
X = 2,
V = [1] ;
false.
代入先がお題に与えられた変数で、かつ値が未確定のときであっても、既に使用されたの数字の割り当ては拒否します。
?- assign(var(_, 3), var('A', X), [1, 2] -> V).
false.
代入先が自由変数ならどんな数字でも割り当て可能です。
?- assign(var(_, 3), var(_, X), [1, 2] -> V).
X = 3,
V = [1, 2].
最上位桁をゼロにしない
'0000 + 0000 = 00000' のような結果を防ぐのと似たような理由で、最上位の桁にある数字は 0 以外にしたいものです。
そのための処理もサブゴールとして定義します。
non_zero_goals([], []).
non_zero_goals(X=Y, Goals) :-
non_zero_goals(X, Goals1),
non_zero_goals(Y, Goals2),
append(Goals1, Goals2, Goals).
non_zero_goals(X + Y, Goals) :-
non_zero_goals(X, Goals1),
non_zero_goals(Y, Goals2),
append(Goals1, Goals2, Goals).
non_zero_goals(X - Y, Goals) :-
non_zero_goals(X, Goals1),
non_zero_goals(Y, Goals2),
append(Goals1, Goals2, Goals).
non_zero_goals([_|Xs], Goals) :-
( Xs = [var(_, Val)] -> Goals = [non_zero(Val)]
; non_zero_goals(Xs, Goals)
).
non_zero(1, Free -> Free).
non_zero(2, Free -> Free).
non_zero(3, Free -> Free).
non_zero(4, Free -> Free).
non_zero(5, Free -> Free).
non_zero(6, Free -> Free).
non_zero(7, Free -> Free).
non_zero(8, Free -> Free).
non_zero(9, Free -> Free).
サブゴールの実行
このようにして得られるサブゴール全てを実行すれば、お題の解が得られます。サブゴール全てについて実行する述語は以下のように書けます。
apply_goals(_, [], Free -> Free).
apply_goals(VPs, [G|Gs], Free -> Free3) :-
call(G, Free -> Free2),
apply_goals(VPs, Gs, Free2 -> Free3).
最初の引数はデバッグ用で、以下のようにすると、Prolog がいろいろ試行錯誤しながら推論している途中経過を見ることができます：
apply_goals(VPs, [], Free -> Free) :- write(VPs), nl.
apply_goals(VPs, [G|Gs], Free -> Free3) :-
call(G, Free -> Free2),
to_result(VPs, S), write(S), nl,
apply_goals(VPs, Gs, Free2 -> Free3).
結果表示
ようやく、お題が解けるようになりました。しかし、お題を解いてもその結果を分かりやすく表示できなくては意味がありません。特に今回の実装では上位桁と下位桁を通常の数値の表示とは逆順にして処理しているのでそのままの表示では誤解を招きます。
お題と同じ形式で結果文字列を返す述語も to_result/2 を用意します。
to_result([], '').
to_result(X=Y, S) :-
to_result(X, S1),
to_result(Y, S2),
string_concat(S1, '=', S0),
string_concat(S0, S2, S).
to_result(X+Y, S) :-
to_result(X, S1),
to_result(Y, S2),
string_concat(S1, '+', S0),
string_concat(S0, S2, S).
to_result(X-Y, S) :-
to_result(X, S1),
to_result(Y, S2),
string_concat(S1, '-', S0),
string_concat(S0, S2, S).
to_result([var(_, X)|Xs], S) :-
to_result(Xs, R),
( var(X) -> A = '_'
; term_string(X, A)
),
string_concat(R, A, S).
推論過程の表示にも使えるように、未確定の部分は '_' にして返します。
すべてつなぎ合わせて動かす
ここまでで道具は揃いました。
つなぎ合わせて覆面算を解くプログラムに仕立てます。
verbal_arithmetic(Q, Result) :-
string_chars(Q, Qs),
phrase(expr(Ps), Qs),
extract_vars(Ps, R),
distinct_list(R, RV),
reverse(RV, Vars),
generate_var_value_pair(Vars, VPairs),
rewrite_goals(VPairs, Ps, VPs),
build_goals(VPs, Goals),
apply_goals(VPs, Goals, [1,2,3,4,5,6,7,8,9,0] -> _),
to_result(VPs, Result).
verbal_arithmetic(Q) :-
verbal_arithmetic(Q, Result),
write(Result), nl.
試しに実行してみます。
?- verbal_arithmetic('SEND+MORE=MONEY', R).
R = "9567+1085=10652" ;
false.
?- verbal_arithmetic('SEND+ME+MORE=MONEY', R).
R = "9346+13+1073=10432" ;
R = "9458+14+1074=10546" ;
false.
軽く検算してみます。
?- X is 9567+1085.
X = 10652.
?- X is 9346+13+1073.
X = 10432.
?- X is 9458+14+1074.
X = 10546.
なんとなく大丈夫そうな気がします。
コマンド化
このままでも実行はできるのですが、いちいち Prolog を立ち上げて読み込ませるのも面倒です。
SWI-Prolog だと
# ! /usr/bin/swipl
:- set_prolog_flag(verbose, silent).
:- initialization main.
のようなおまじないを先頭部分に追加して
verbal_arithmetics([]).
verbal_arithmetics([Arg|Argv]) :-
atom_string(Arg, S),
verbal_arithmetic(S),
verbal_arithmetics(Argv).
main :-
current_prolog_flag(argv, Argv),
verbal_arithmetics(Argv), fail.
main :-
halt(1).
のような main 述語を書くと、Prolog プログラムをコマンドとして実行可能です。
実行例
こんな感じで、引数にお題を与えるとその解の一覧を表示します。
$ time ./send_me_more_money.pl 'send+more=money'
9567+1085=10652
real 0m0.026s
user 0m0.026s
sys 0m0.000s
$ time ./send_me_more_money.pl 'send+me+more=money'
9346+13+1073=10432
9458+14+1074=10546
real 0m0.124s
user 0m0.124s
sys 0m0.000s
「自分に」などと余計な言葉を付け加えると減額されてしまうようです。
さらに欲張るとしばらく悩んだうえで拒否されます（結果が得られない）:
$ time ./send_me_more_money.pl 'send+me+much+more=money'
real 0m8.475s
user 0m8.469s
sys 0m0.004s
もう少しだけ丁寧にお願いしてみてもだめでした:
$ time ./send_me_more_money.pl 'send+much+more+money=please'
real 0m30.231s
user 0m30.227s
sys 0m0.000s
やはりお願いする立場なので、謙虚さが重要なようです:
$ time ./send_me_more_money.pl 'SEND+ME+SOME=MONEY'
8306+13+8713=17032
8309+13+8713=17035
8632+16+8716=17364
8630+16+8716=17362
real 0m0.107s
user 0m0.107s
sys 0m0.000s
他にもお題はないかと英語版 Wikipedia を見るとこんなのがありました。
$ time ./send_me_more_money.pl 'to+go=out'
21+81=102
real 0m0.023s
user 0m0.019s
sys 0m0.004s
もう一つあるこちらは、流石にお題が長すぎて長考に入ってそのままになってしまいます。
$ time ./send_me_more_money.pl 'SO+MANY+MORE+MEN+SEEM+TO+SAY+THAT+THEY+MAY+SOON+TRY+TO+STAY+AT+HOME+SO+AS+TO+SEE+OR+HEAR+THE+SAME+ONE+MAN+TRY+TO+MEET+THE+TEAM+ON+THE+MOON+AS+HE+HAS+AT+THE+OTHER+TEN=TESTS'
TODO
ぱっと見た感じ大丈夫そうですが、出力内容が常に正しいのか自信がありません。別途検証する必要があります。