Более быстрое внедрение словесной арифметики в прологе
Я уже сделал рабочий обобщенный вербальный арифметический решатель в Прологе, но он слишком медленный. Требуется 8 минут, чтобы запустить простое выражение S E N D + M O R E = M O N E 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.
6 ответов
Подумайте об использовании конечных доменных ограничений, например, в 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.
Плохая производительность здесь из-за формирования всех возможных назначений букв перед проверкой, если это возможно.
Мой совет: "Неудача рано, часто неудача". Таким образом, как можно раньше вставьте как можно больше проверок на наличие ошибок в этапы назначения, таким образом обрезая дерево поиска.
Клас Линдбек делает несколько хороших предложений. Как обобщение, при добавлении двух чисел перенос не более одного в каждом месте. Таким образом, присвоение различных цифр буквам слева направо может быть проверено с учетом возможности пока еще неопределенного переноса в крайних правых местах. (Конечно, в последнем месте "юнитов" нет переноса.)
Надо много думать, поэтому логика ограничений, как предполагает 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 должно быть какой-то другой ненулевой цифрой. Комментарии показывают шаги, где дополнительным буквам могут быть детерминированно назначенные значения на основе уже сделанного выбора.
Добавлено (2): Вот "общий" решатель криптарифмов для двух слагаемых, которые не должны иметь одинаковую длину / количество "мест". Код для длины /2 опускается как довольно распространенный встроенный предикат, и, принимая предложение Уилла Несса, вызовы для исключения /3 заменяются на select/3 для удобства пользователей SWI-Prolog.
Я проверил это с Амзи! и SWI-Prolog, использующий те примеры альфа- метрики http://www.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___).
Я думаю, это показывает, что преимущества поиска / оценки слева направо могут быть достигнуты в "обобщенном" решателе, увеличивая число выводов примерно в два раза по сравнению с более ранним "адаптированным" кодом.
Примечание. В этом ответе обсуждается алгоритм уменьшения количества комбинаций, которые необходимо попробовать. Я не знаю Пролог, поэтому не могу предоставить ни одного фрагмента кода.
Хитрость для ускорения решения проблемы грубой силы - это ярлыки. Если вы можете определить диапазон недопустимых комбинаций, вы можете существенно сократить количество комбинаций.
Возьмите пример в руки. Когда человек решает это, он немедленно замечает, что ДЕНЬГИ имеют 5 цифр, в то время как ОТПРАВИТЬ и БОЛЬШЕ имеют только 4, поэтому М в ДЕНЬГАХ должно быть цифрой 1. 90% комбинаций исчезли!
При создании алгоритма для компьютера мы стараемся использовать ярлыки, которые сначала применяются ко всем возможным вводам. Если они не дают требуемой производительности, мы начинаем искать ярлыки, которые применяются только к конкретным комбинациям ввода. Поэтому мы оставляем ярлык M=1 на данный момент.
Вместо этого я бы остановился на последних цифрах. Мы знаем, что (D+E) mod 10 = Y. Это наше снижение количества комбинаций на 90%.
Этот шаг должен привести к освобождению чуть менее минуты.
Что мы можем сделать, если этого недостаточно? Следующий шаг: посмотрите на последнюю цифру! Мы знаем, что (N+R+ перенос из D+E) mod 10 = E.
Поскольку мы тестируем все действительные комбинации последней цифры, для каждого теста мы будем знать, является ли перенос 0 или 1. Сложность (для кода), которая еще больше сокращает количество тестируемых комбинаций, заключается в том, что мы столкнемся с дубликатами. (буква сопоставляется с номером, который уже присвоен другой букве). Когда мы сталкиваемся с дубликатом, мы можем перейти к следующей комбинации, не идя дальше по цепочке.
Удачи с вашим заданием!
Вот мой взгляд на это. Я использую clpfd, dcg и мета-предикат 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(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).
Быстрый и грязный хак для сброса всех найденных решений:
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]). Уравнение = ([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]). Уравнение = ([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]). Уравнение = ([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, МНЕ] Уравнение = (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]). Уравнение = (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 ])). Уравнение = ([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 ЦП за 3,928 секунды (100% ЦП, 9085480 губ) true.?- время (solve_n_dump ([ff], [D, O, N, A, L, D] + [G, E, R, A, L, D] # = [R, O, B, E, R, Т])). Уравнение = ([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 секунды (100% ЦП, 8533271 Губ) верно.
Уилл Несс стиль, обобщенный (но при условии, 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.
У тебя есть
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 Пролог. Вооружившись этим инструментом, вы можете постепенно выбирать цифры из своего сужающегося домена:
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)
Теперь задача состоит в том, чтобы сделать его общим.