在 Prolog 中更快地实现口头算术
Posted
技术标签:
【中文标题】在 Prolog 中更快地实现口头算术【英文标题】：Faster implementation of verbal arithmetic in Prolog 【发布时间】：2012-06-11 02:56:01 【问题描述】：我已经在 Prolog 中制作了一个通用的 verbal arithmetic 求解器，但它太慢了。运行简单的表达式 S E N D + M O R E = M O N E Y 需要 8 分钟。有人可以帮我让它运行得更快吗？
/* verbalArithmetic(List,Word1,Word2,Word3) where List is the list of all
possible letters in the words. The SEND+MORE = MONEY expression would then
be represented as
verbalArithmetic([S,E,N,D,M,O,R,Y],[S,E,N,D],[M,O,R,E],[M,O,N,E,Y]). */
validDigit(X) :- member(X,[0,1,2,3,4,5,6,7,8,9]).
validStart(X) :- member(X,[1,2,3,4,5,6,7,8,9]).
assign([H|[]]) :- validDigit(H).
assign([H|Tail]) :- validDigit(H), assign(Tail), fd_all_different([H|Tail]).
findTail(List,H,T) :- append(H,[T],List).
convert([T],T) :- validDigit(T).
convert(List,Num) :- findTail(List,H,T), convert(H,HDigit), Num is (HDigit*10+T).
verbalArithmetic(WordList,[H1|Tail1],[H2|Tail2],Word3) :-
validStart(H1), validStart(H2), assign(WordList),
convert([H1|Tail1],Num1),convert([H2|Tail2],Num2), convert(Word3,Num3),
Sum is Num1+Num2, Num3 = Sum.
【问题讨论】：
【参考方案1】：考虑使用finite domain constraints，例如，在 SWI-Prolog 中：
:- use_module(library(clpfd)).
puzzle([S,E,N,D] + [M,O,R,E] = [M,O,N,E,Y]) :-
Vars = [S,E,N,D,M,O,R,Y],
Vars ins 0..9,
all_different(Vars),
S*1000 + E*100 + N*10 + D +
M*1000 + O*100 + R*10 + E #=
M*10000 + O*1000 + N*100 + E*10 + Y,
M #\= 0, S #\= 0.
查询示例：
?- time((puzzle(As+Bs=Cs), label(As))).
% 5,803 inferences, 0.002 CPU in 0.002 seconds (98% CPU, 3553582 Lips)
As = [9, 5, 6, 7],
Bs = [1, 0, 8, 5],
Cs = [1, 0, 6, 5, 2] ;
% 1,411 inferences, 0.001 CPU in 0.001 seconds (97% CPU, 2093472 Lips)
false.
【讨论】：
【参考方案2】：这里表现不佳是由于在检查是否可行之前形成所有可能的字母分配。
我的建议是“尽早失败，经常失败”。也就是说，尽早将尽可能多的失败检查推送到分配步骤中，从而修剪搜索树。
Klas Lindbäck 提出了一些很好的建议。作为概括，当添加两个数字时，每个位置最多有一个进位。因此，可以检查从左到右对字母的不同数字的分配，同时考虑到在最右边的位置可能存在尚未确定的进位。 （当然在最后的“单位”处，是没有进位的。）
要考虑的东西很多，这就是为什么约束逻辑，正如 mat 所建议的那样（你已经用 fd_all_different/1 讨论过）如此方便。
补充：这是一个没有约束逻辑的Prolog解决方案，只使用一个辅助谓词omit/3：
omit(H,[H|T],T).
omit(X,[H|T],[H|Y]) :- omit(X,T,Y).
它既从列表中选择一个项目，又生成没有该项目的缩短列表。
下面是 sendMoreMoney/3 的代码，它通过从左到右求和来进行搜索：
sendMoreMoney([S,E,N,D],[M,O,R,E],[M,O,N,E,Y]) :-
M = 1,
omit(S,[2,3,4,5,6,7,8,9],PoolO),
(CarryS = 0 ; CarryS = 1),
%% CarryS + S + M = M*10 + O
O is (CarryS + S + M) - (M*10),
omit(O,[0|PoolO],PoolE),
omit(E,PoolE,PoolN),
(CarryE = 0 ; CarryE = 1),
%% CarryE + E + O = CarryS*10 + N
N is (CarryE + E + O) - (CarryS*10),
omit(N,PoolN,PoolR),
(CarryN = 0 ; CarryN = 1),
%% CarryN + N + R = CarryE*10 + E
R is (CarryE*10 + E) - (CarryN + N),
omit(R,PoolR,PoolD),
omit(D,PoolD,PoolY),
%% D + E = CarryN*10 + Y
Y is (D + E) - (CarryN*10),
omit(Y,PoolY,_).
我们通过观察 M 必须是最左边数字和的非零进位来快速开始，因此是 1，并且 S 必须是其他一些非零数字。 cmets 显示了可以根据已经做出的选择确定性地为其他字母分配值的步骤。
已添加（2）：这是一个用于两个加法的“通用”密码算法求解器，它们不需要具有相同的“位置”长度/数量。 length/2 的代码作为一个相当常见的内置谓词被省略，并接受 Will Ness 的建议，对 omit/3 的调用被替换为 select/3 方便 SWI-Prolog 用户。
我已经用 Amzi 测试过了！和 SWI-Prolog 使用那些字母表示例from Cryptarithms.com，其中涉及两个加法，每个加法都有一个独特的解决方案。我还用十几个解决方案组成了一个示例，I + AM = BEN，以测试正确的回溯。
solveCryptarithm([H1|T1],[H2|T2],Sum) :-
operandAlign([H1|T1],[H2|T2],Sum,AddTop,AddPad,Carry,TSum,Pool),
solveCryptarithmAux(H1,H2,AddTop,AddPad,Carry,TSum,Pool).
operandAlign(Add1,Add2,Sum,AddTop,AddPad,Carry,TSum,Pool) :-
operandSwapPad(Add1,Add2,Length,AddTop,AddPad),
length(Sum,Size),
( Size = Length
-> ( Carry = 0, Sum = TSum , Pool = [1|Peel] )
; ( Size is Length+1, Carry = 1, Sum = [Carry|TSum], Pool = Peel )
),
Peel = [2,3,4,5,6,7,8,9,0].
operandSwapPad(List1,List2,Length,Longer,Padded) :-
length(List1,Length1),
length(List2,Length2),
( Length1 >= Length2
-> ( Length = Length1, Longer = List1, Shorter = List2, Pad is Length1 - Length2 )
; ( Length = Length2, Longer = List2, Shorter = List1, Pad is Length2 - Length1 )
),
zeroPad(Shorter,Pad,Padded).
zeroPad(L,0,L).
zeroPad(L,K,P) :-
K > 0,
M is K-1,
zeroPad([0|L],M,P).
solveCryptarithmAux(_,_,[],[],0,[],_).
solveCryptarithmAux(NZ1,NZ2,[H1|T1],[H2|T2],CarryOut,[H3|T3],Pool) :-
( CarryIn = 0 ; CarryIn = 1 ), /* anticipatory carry */
( var(H1)
-> select(H1,Pool,P_ol)
; Pool = P_ol
),
( var(H2)
-> select(H2,P_ol,P__l)
; P_ol = P__l
),
( var(H3)
-> ( H3 is H1 + H2 + CarryIn - 10*CarryOut, select(H3,P__l,P___) )
; ( H3 is H1 + H2 + CarryIn - 10*CarryOut, P__l = P___ )
),
NZ1 \== 0,
NZ2 \== 0,
solveCryptarithmAux(NZ1,NZ2,T1,T2,CarryIn,T3,P___).
我认为这说明了从左到右搜索/评估的优势可以在“通用”求解器中获得，与早期的“定制”代码相比，推理次数大约增加了两倍。
【讨论】：
您的omit/3 是 SWI-Prolog 的 select/3。各种称为del/3、delete/3 等。使用它可以直接操作有限域（或“池”）。我的答案中的selectM/3 谓词将select/3 的多个调用组合为一个，以便更轻松、更短地编码。此外，您的代码采用了大量的人工推理。
@WillNess：SWI-Prolog 确实内置了该（等效）谓词。我试图说明从左到右评估的好处，感谢您的从右到左版本，我们可以进行比较。
所以我尝试了你的版本，它花费了 533(676) 推理/0.00 秒，而我的版本花费了 27,653(38,601) 推理/0.02 秒。 :) 考虑到您的代码中包含大量人工推理，这并不奇怪，相比之下，这要形式化要困难得多（毕竟，这就是原始 Q 的含义）。 WP 文章，例如无需任何代码即可得出完整的解决方案，将人类推理更进一步。
你太过分了！！ :) :) 您的新代码确实看起来通用。经测试，它显示需要 833 次推理才能得出解决方案，并需要 1477 次推理才能充分探索搜索空间。
@WillNess：感谢您的好意和慷慨的奖励！我很欣赏“走廊代码审查”。【参考方案3】：
注意：此答案讨论了一种用于减少需要尝试的组合数量的算法。我不懂Prolog，所以无法提供任何代码sn-ps。
加速蛮力解决方案的诀窍是捷径。如果您可以识别出无效的组合范围，则可以大大减少组合的数量。
举个例子。当一个人解决它时，她立即注意到 MONEY 有 5 个数字，而 SEND 和 MORE 只有 4 个，所以 MONEY 中的 M 必须是数字 1。90% 的组合消失了！
在为计算机构建算法时，我们首先尝试使用适用于所有可能输入的快捷方式。如果它们未能提供所需的性能，我们将开始查看仅适用于特定输入组合的快捷方式。 所以我们暂时保留 M=1 快捷方式。
相反，我会关注最后一位数字。 我们知道 (D+E) mod 10 = Y。 我们尝试的组合数量减少了 90%。
这一步应该可以将执行时间缩短到不到一分钟。
如果这还不够，我们该怎么办？ 下一步： 看倒数第二个数字！ 我们知道 (N+R+carry from D+E) mod 10 = E。
由于我们正在测试最后一位数字的所有有效组合，因此对于每个测试，我们都会知道进位是 0 还是 1。 进一步减少要测试的组合数量的复杂情况（对于代码）是我们将遇到重复项（一个字母被映射到一个已经分配给另一个字母的数字）。当我们遇到重复时，我们可以前进到下一个组合，而无需再往下走。
祝你的任务好运！
【讨论】：
非常好的推理，+1！这正是 CLP(FD) 版本在幕后为您所做的。例如，当我查询：?- puzzle([S,E,N,D] + [M,O,R,E] = [M,O,N,E,Y]).，然后我得到变量绑定：M = 1, O = 0, S = 9，因此只需发布描述难题的 CLP(FD) 约束，就可以轻松地将 3 个变量固定为具体整数。正如我们从剩余目标中看到的那样，剩余变量的域也减少了：N in 5..8, E in 4..7, R in 2..8, Y in 2..8。最后的搜索步骤找到唯一解作为所有 CLP(FD) 变量的具体整数绑定。【参考方案4】：
这是我的看法。我用clpfd，dcg，
和meta-predicatemapfoldl/5：
:- meta_predicate mapfoldl(4,?,?,?,?).
mapfoldl(P_4,Xs,Zs, S0,S) :-
list_mapfoldl_(Xs,Zs, S0,S, P_4).
:- meta_predicate list_mapfoldl_(?,?,?,?,4).
list_mapfoldl_([],[], S,S, _).
list_mapfoldl_([X|Xs],[Y|Ys], S0,S, P_4) :-
call(P_4,X,Y,S0,S1),
list_mapfoldl_(Xs,Ys, S1,S, P_4).
让我们好好利用mapfoldl/5，做一些口头算术！
:- use_module(library(clpfd)).
:- use_module(library(lambda)).
digits_number(Ds,Z) :-
Ds = [D0|_],
Ds ins 0..9,
D0 #\= 0, % most-significant digit must not equal 0
reverse(Ds,Rs),
length(Ds,N),
numlist(1,N,Es), % exponents (+1)
maplist(\E1^V^(V is 10**(E1-1)),Es,Ps),
scalar_product(Ps,Rs,#=,Z).
list([]) --> [].
list([E|Es]) --> [E], list(Es).
cryptarithexpr_value([V|Vs],X) -->
digits_number([V|Vs],X) ,
list([V|Vs]).
cryptarithexpr_value(T0,T) -->
functor(T0,F,A) ,
dif(F-A,'.'-2) ,
T0 =.. [F|Args0] ,
mapfoldl(cryptarithexpr_value,Args0,Args),
T =.. [F|Args] .
crypt_arith_(Expr,Zs) :-
phrase(cryptarithexpr_value(Expr,Goal),Zs0),
( member(Z,Zs0), \+var(Z)
-> throw(error(uninstantiation_error(Expr),crypt_arith_/2))
; true
),
sort(Zs0,Zs),
all_different(Zs),
call(Goal).
快速而肮脏的 hack 转储 所有解决方案：
solve_n_dump(Opts,Eq) :-
( crypt_arith_(Eq,Zs),
labeling(Opts,Zs),
format('Eq = (~q), Zs = ~q.~n',[Eq,Zs]),
false
; true
).
solve_n_dump(Eq) :- solve_n_dump([],Eq).
让我们试试吧！
?-solve_n_dump([S,E,N,D]+[M,O,R,E] #= [M,O,N,E,Y])。 Eq = ([9,5,6,7]+[1,0,8,5]#=[1,0,6,5,2]), Zs = [9,5,6,7,1, 0,8,2]。 真的。 ?-solve_n_dump([C,R,O,S,S]+[R,O,A,D,S] #= [D,A,N,G,E,R])。 Eq = ([9,6,2,3,3]+[6,2,5,1,3]#=[1,5,8,7,4,6]), Zs = [9,6, 2,3,5,1,8,7,4]。 真的。 ?-solve_n_dump([F,O,R,T,Y]+[T,E,N]+[T,E,N] #= [S,I,X,T,Y])。 Eq = ([2,9,7,8,6]+[8,5,0]+[8,5,0]#=[3,1,4,8,6]), Zs = [2, 9,7,8,6,5,0,3,1,4]。 真的。 ?-solve_n_dump([E,A,U]*[E,A,U] #= [O,C,E,A,N])。 方程 = ([2,0,3]*[2,0,3]#=[4,1,2,0,9])，Zs = [2,0,3,4,1,9]。 真的。 ?-solve_n_dump([N,U,M,B,E,R] #= 3*[P,R,I,M,E])。 % 等同于：[N,U,M,B,E,R] #= [P,R,I,M,E]+[P,R,I,M,E]+[P,R,I,我] Eq = (3*[5,4,3,2,8]#=[1,6,2,9,8,4]), Zs = [5,4,3,2,8,1,6, 9]。 真的。 ?-solve_n_dump(3*[C,O,F,F,E,E] #= [T,H,E,O,R,E,M])。 Eq = (3*[8,3,1,1,9,9]#=[2,4,9,3,5,9,7]), Zs = [8,3,1,9,2, 4,5,7]。 真的。让我们做更多，尝试一些不同的labeling options：
?- time(solve_n_dump([],[D,O,N,A,L,D]+[G,E,R,A,L,D] #= [R,O, B，E，R，T]））。 Eq = ([5,2,6,4,8,5]+[1,9,7,4,8,5]#=[7,2,3,9,7,0]), Zs = [ 5,2,6,4,8,1,9,7,3,0]。 % 35,696,801 次推理，3.929 个 CPU，3.928 秒（100% CPU，9085480 个嘴唇） 真的。 ?- time(solve_n_dump([ff],[D,O,N,A,L,D]+[G,E,R,A,L,D] #= [R,O ,B,E,R,T]))。 Eq = ([5,2,6,4,8,5]+[1,9,7,4,8,5]#=[7,2,3,9,7,0]), Zs = [ 5,2,6,4,8,1,9,7,3,0]。 % 2,902,871 推理，0.340 CPU 在 0.340 秒（100% CPU，8533271 唇） 真的。【讨论】：
【参考方案5】：Will Ness 风格，广义（但假设为 length(A) <= length(B)）求解器：
money_puzzle(A, B, C) :-
maplist(reverse, [A,B,C], [X,Y,Z]),
numlist(0, 9, Dom),
swc(0, Dom, X,Y,Z),
A \= [0|_], B \= [0|_].
swc(C, D0, [X|Xs], [Y|Ys], [Z|Zs]) :-
peek(D0, X, D1),
peek(D1, Y, D2),
peek(D2, Z, D3),
S is X+Y+C,
( S > 9 -> Z is S - 10, C1 = 1 ; Z = S, C1 = 0 ),
swc(C1, D3, Xs, Ys, Zs).
swc(C, D0, [], [Y|Ys], [Z|Zs]) :-
peek(D0, Y, D1),
peek(D1, Z, D2),
S is Y+C,
( S > 9 -> Z is S - 10, C1 = 1 ; Z = S, C1 = 0 ),
swc(C1, D2, [], Ys, Zs).
swc(0, _, [], [], []).
swc(1, _, [], [], [1]).
peek(D, V, R) :- var(V) -> select(V, D, R) ; R = D.
性能：
?- time(money_puzzle([S,E,N,D],[M,O,R,E],[M,O,N,E,Y])).
% 38,710 inferences, 0.016 CPU in 0.016 seconds (100% CPU, 2356481 Lips)
S = 9,
E = 5,
N = 6,
D = 7,
M = 1,
O = 0,
R = 8,
Y = 2 ;
% 15,287 inferences, 0.009 CPU in 0.009 seconds (99% CPU, 1685686 Lips)
false.
?- time(money_puzzle([D,O,N,A,L,D],[G,E,R,A,L,D],[R,O,B,E,R,T])).
% 14,526 inferences, 0.008 CPU in 0.008 seconds (99% CPU, 1870213 Lips)
D = 5,
O = 2,
N = 6,
A = 4,
L = 8,
G = 1,
E = 9,
R = 7,
B = 3,
T = 0 ;
% 13,788 inferences, 0.009 CPU in 0.009 seconds (99% CPU, 1486159 Lips)
false.
【讨论】：
【参考方案6】：你有
convert([A,B,C,D]) => convert([A,B,C])*10 + D
=> (convert([A,B])*10+C)*10+D => ...
=> ((A*10+B)*10+C)*10+D
因此，您可以使用简单的线性递归来表达这一点。
更重要的是，当您从您的域0..9 中选择一个可能的数字时，您不应再使用该数字进行后续选择：
selectM([A|As],S,Z):- select(A,S,S1),selectM(As,S1,Z).
selectM([],Z,Z).
select/3 在 SWI Prolog 中可用。有了这个工具，您可以逐渐从您缩小的域中选择您的数字：
money_puzzle( [[S,E,N,D],[M,O,R,E],[M,O,N,E,Y]]):-
Dom = [0,1,2,3,4,5,6,7,8,9],
selectM([D,E], Dom,Dom1), add(D,E,0, Y,C1), % D+E=Y
selectM([Y,N,R],Dom1,Dom2), add(N,R,C1,E,C2), % N+R=E
select( O, Dom2,Dom3), add(E,O,C2,N,C3), % E+O=N
selectM([S,M], Dom3,_), add(S,M,C3,O,M), % S+M=MO
S \== 0, M \== 0.
我们可以将两个数字与进位相加，相加产生一个带有新进位的结果数字（例如，4+8 (0) = 2 (1)，即 12）：
add(A,B,C1,D,C2):- N is A+B+C1, D is N mod 10, C2 is N // 10 .
如此实现，money_puzzle/1 立即运行，这要归功于数字被挑选和测试的渐进性立即：
?- time( money_puzzle(X) ).
% 27,653 inferences, 0.02 CPU in 0.02 seconds (100% CPU, 1380662 Lips)
X = [[9, 5, 6, 7], [1, 0, 8, 5], [1, 0, 6, 5, 2]] ;
No
?- time( (money_puzzle(X),fail) ).
% 38,601 inferences, 0.02 CPU in 0.02 seconds (100% CPU, 1927275 Lips)
现在面临的挑战是使其通用化。
【讨论】：
以上是关于在 Prolog 中更快地实现口头算术的主要内容，如果未能解决你的问题，请参考以下文章