在Prolog中更快地实现了口头运算
我已经在Prolog中做了一个可操作的广义的语言algorithm求解器，但是它太慢了。 只需要8分钟即可运行简单的expression式SEND + MORE = MONE Y.有人可以帮助我使其运行得更快吗？
/* 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. 考虑使用有限域约束 ，例如，在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.
这里performance不佳的原因是在检查是否可行之前先形成所有可能的字母分配。
我的build议是“失败早，经常失败”。 也就是说，尽可能多的尽可能多的检查失败的分配步骤，从而修剪search树。
KlasLindbäck提出了一些很好的build议。 作为一个概括，当增加两个数字时，进位在每个地方最多一个。 因此，可以检查从左到右分配不同数字到字母的位置，以便在最右边的位置考虑到尚未确定的进位的可能性。 （当然在最后的“单位”地方，没有携带。）
这是很多要考虑的，这就是为什么约束逻辑，正如你所说的（而且你已经用fd_all_different / 1提到的），这是一个很方便的原因。
补充：这是一个没有约束逻辑的Prolog解决scheme，只使用一个辅助谓词omit / 3 ：
omit(H,[H|T],T). omit(X,[H|T],[H|Y]) :- omit(X,T,Y).
它们都从列表中select一个项目，并生成没有该项目的缩短列表。
这里是sendMoreMoney / 3的代码，通过从左到右评估总和进行search：
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必须是其他非零数字。 注释显示了附加字母可以基于已经做出的select确定性地分配值的步骤。
增加（2）：这是一个“一般”的对数求解器，用于两个加数，它们不必具有相同的长度/数量的“地点”。 作为一个相当常见的内置谓词，省略了长度/ 2的代码，并且为了方便SWI-Prolog用户，考虑到Will Ness的build议，将省略/ 3的调用replace为select / 3 。
我已经用Amzitesting过了 和SWI-Prolog使用来自Cryptarithms.com的那些涉及两个加法的字母例子，每个加法都有独特的解决scheme。 我还用一打解决scheme做了一个例子，I + AM = BEN，来testing正确的回溯。
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___).
我认为这说明了从左到右的search/评估的优势可以在“广义”求解器中获得，与早期的“定制”代码相比，推理的数量增加了大约两倍。
注意：这个答案讨论了一个减less需要尝试的组合数量的algorithm。 我不知道Prolog，所以我不能提供任何代码片段。
加快蛮力解决scheme的诀窍是快捷方式。 如果你能确定一系列无效的组合，你可以大大减less组合的数量。
以手中的例子。 当一个人解决时，她立即注意到MONEY有5个数字，而SEND和MORE只有4个，所以MONEY中的M必须是数字1. 90％的组合消失了！
为计算机构buildalgorithm时，我们尝试使用适用于所有可能input的快捷方式。 如果他们不能提供所需的性能，我们开始考虑只适用于特定input组合的快捷方式。 所以我们现在离开M = 1的快捷方式。
相反，我会专注于最后的数字。 我们知道（D + E）mod 10 = Y.这就是我们尝试的组合数量减less了90％。
这一步应该带来实现不到一分钟。
如果这还不够，我们能做些什么？ 下一步：看倒数第二个数字！ 我们知道（N + R +来自D + E）mod 10 = E.
由于我们正在通过最后一位数字的所有有效组合进行testing，因此对于每个testing，我们将知道进位是0还是1.进一步减less要testing的组合的数量的复杂（对于代码）是我们将会遇到重复（一个字母被映射到已经分配给另一个字母的数字）。 当我们遇到一个重复的时候，我们可以进入下一个组合，而不必再往下走。
祝你好运！
你有
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
所以，你可以用一个简单的线性recursionexpression这个。
更重要的是，当您从您的域0..9select一个可能的数字时，您不应再使用该数字作为后续select：
selectM([A|As],S,Z):- select(A,S,S1),selectM(As,S1,Z). selectM([],Z,Z).
在SWI Prolog中select/3是可用的。 有了这个工具，您可以从缩小的范围中逐渐select您的数字：
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即时运行，这要归功于数字被逐渐挑选和testing的渐进性：
?- 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)
现在的挑战变成了通用。
这是我的承诺。 我使用clpfd ， dcg和meta-predicate mapfoldl/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(FA,'.'-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).
快速和肮脏的黑客转储发现的所有解决scheme ：
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).
让我们试试吧！
parsing_转储（[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]。 真正。 parsing_转储（[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]）。 Eq =（[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]。 真正。
让我们做更多的尝试一些不同的标签选项 ：
时间（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。 ％推断，3.929 CPU 3.967秒 （100％CPU，9085480嘴唇） 真正。 时间（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秒内 0.340个CPU（100％CPU，8533271个嘴唇） 真正。
将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.
