Более быстрая реализация словесной арифметики в Prolog

Я уже создал рабочий обобщенный вербальный арифметический решатель в Prolog, но он слишком медленный. Это займет 8 минут, чтобы запустить простое выражение 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. 

    6 Solutions collect form web for “Более быстрая реализация словесной арифметики в Prolog”

    Рассмотрим использование ограничений конечных доменов , например, в 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. 

    Плохая производительность здесь обусловлена ​​формированием всех возможных почтовых заданий, прежде чем проверять, возможны ли какие-либо действия.

    Мой совет: «не сдавайся рано, не часто». То есть, нажимайте столько проверок на отказ как можно раньше на шаги назначения, таким образом обрезая дерево поиска.

    Klas Lindbäck предлагает хорошие предложения. В качестве обобщения при добавлении двух чисел перенос не более одного в каждом месте. Таким образом, назначение отдельных цифр буквам слева направо может быть проверено с учетом возможности пока еще неопределенного переноса в самых правых местах. (Конечно, в финальных «единицах» места нет.)

    Об этом много думать, поэтому логика ограничений, как предлагает матовый (и который вы уже обсуждали с помощью 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 опущен как довольно распространенный встроенный предикат, и, принимая предложение Will Ness, вызовы omit / 3 заменяются на select / 3 для удобства пользователей SWI-Prolog.

    Я проверил это с Амзи! и SWI-Prolog, используя эти примеры альфа- карт от Cryptarithms.com, которые include в себя два слагаемых, каждый из которых имеет уникальное решение. Я также составил пример с десятком решений, 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___). 

    Я думаю, это иллюстрирует, что преимущества поиска / оценки слева направо могут быть достигнуты в «обобщенном» решателе, увеличивая количество выводов примерно в два раза по сравнению с более ранним «адаптированным» кодом.

    Примечание. В этом ответе обсуждается алгоритм сокращения количества комбинаций, которые необходимо попробовать. Я не знаю Prolog, поэтому я не могу предоставить fragmentы кода.

    Ярлыки для ускорения решения грубой силы. Если вы можете определить диапазон комбинаций, которые являются недействительными, вы можете существенно уменьшить количество комбинаций.

    Возьмите пример в руке. Когда человек решает это, она сразу же замечает, что ДЕНЬГИ имеет 5 цифр, а SEND и MORE – только 4, поэтому M в MONEY должна быть цифрой 1. 90% комбинаций ушли!

    При построении алгоритма для компьютера мы пытаемся использовать ярлыки, которые применяются ко всем возможным вводам. Если они не дают требуемой производительности, мы начинаем искать ярлыки, которые применяются только к конкретным комбинациям ввода. Итак, на данный момент мы оставляем ярлык M = 1.

    Вместо этого я бы сосредоточился на последних цифрах. Мы знаем, что (D + E) mod 10 = Y. Это 90% -ное сокращение количества комбинаций, которые нужно попробовать.

    Этот шаг должен довести до конца менее минуты.

    Что мы можем сделать, если этого недостаточно? Следующий шаг: посмотрите на вторую цифру! Мы знаем, что (N + R + несут из D + E) mod 10 = E.

    Поскольку мы тестируем все допустимые комбинации последней цифры, для каждого теста мы будем знать, является ли перенос 0 или 1. Усложнение (для кода), которое дополнительно уменьшает количество тестируемых комбинаций, заключается в том, что мы будем сталкиваться с дубликатами (письмо сопоставляется с номером, который уже назначен другой букве). Когда мы сталкиваемся с дубликатом, мы можем перейти к следующей комбинации, не двигаясь дальше по цепочке.

    Удачи вам в назначении!

    У тебя есть

     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) 

    Теперь задача состоит в том, чтобы сделать ее общей.

    Вот мое занятие. Я использую 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(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). 

    Быстрый и грязный взломать все найденные решения :

     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]).
     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].
     % 35,696,801 выводов, 3,929 CPU за 3,928 секунды (100% процессор, 9085480 губ)
     правда.
    
     ? - время (solve_n_dump ( [ff] , [D, O, N, A, L, D] + [G, E, R, A, L, D] # = [R, O, B, E, R, Т])).
     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% процессор, 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. 
    Interesting Posts

    reactjs setState не обновляется немедленно

    Установка Windows 7 (с двойной загрузкой) после установки Windows 8

    Как редактировать и отлаживать источники библиотеки R

    подсчитать количество вызовов пункта

    Как объединить два кадра данных на основе двух столбцов?

    замените String другим в java

    Скрыть / показать отдельные элементы внутри ngFor

    Инициализатор поля не может ссылаться на нестатические поля, метод или свойство?

    Сортировка по строке, которая может содержать число

    Что такое class оболочки?

    Как получить второе возвращаемое значение из функции без использования временных переменных?

    Преобразование String в другую локаль в java

    Просмотр файлов в ZIP-архиве в Linux

    Как управлять уровнем громкости системы на OS X с помощью клавиатуры без средств массовой информации?

    Как получить доступ к папке данных / данных на устройстве Android?

    Давайте будем гением компьютера.