2012-06-07 14 views
7

Ho già eseguito un risolutore generalizzato verbal arithmetic in Prolog, ma è troppo lento. Ci vogliono 8 minuti solo per eseguire l'espressione semplice. S E N D + M O R E = M O N E Y. Qualcuno può aiutarmi a farlo funzionare più velocemente?Implementazione più veloce dell'aritmetica verbale in Prolog

/* 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. 

risposta

3

Nota: questa risposta illustra un algoritmo per ridurre il numero di combinazioni da provare. Non conosco Prolog, quindi non posso fornire alcun frammento di codice.

Il trucco per accelerare una soluzione di forza bruta è scorciatoie. Se riesci a identificare un intervallo di combinazioni non valide, puoi ridurre sostanzialmente il numero di combinazioni.

Prendete l'esempio in mano. Quando un essere umano lo risolve, nota immediatamente che MONEY ha 5 cifre mentre SEND e MORE ne hanno solo 4, quindi la M in MONEY deve essere la cifra 1. Il 90% delle combinazioni è andato!

Quando si costruisce un algoritmo per un computer, si tenta di utilizzare scorciatoie che si applicano prima a tutti gli input possibili. Se non riescono a fornire le prestazioni richieste, iniziamo a guardare le scorciatoie che si applicano solo a specifiche combinazioni di input. Quindi per ora lasciamo la scorciatoia M = 1.

Invece, vorrei concentrarmi sulle ultime cifre. Sappiamo che (D + E) mod 10 = Y. Questa è la nostra riduzione del 90% del numero di combinazioni da provare.

Questo passaggio dovrebbe portare l'esecuzione a poco meno di un minuto.

Cosa possiamo fare se non è sufficiente? Passaggio successivo: Guarda la penultima cifra! Sappiamo che (N + R + porta da D + E) mod 10 = E.

Dato che stiamo testando tutte le combinazioni valide dell'ultima cifra, per ogni test sapremo se il carry è 0 o 1 Una complicazione (per il codice) che riduce ulteriormente il numero di combinazioni da testare è che incontreremo duplicati (una lettera viene mappata su un numero che è già assegnato a un'altra lettera). Quando incontriamo un duplicato, possiamo passare alla combinazione successiva senza andare più in basso.

Buona fortuna per il tuo incarico!

+1

Molto bel ragionamento, +1! Questo è esattamente ciò che la versione CLP (FD) fa per te dietro le quinte. Per esempio, quando chiedo: '? - puzzle ([S, E, N, D] + [M, O, R, E] = [M, O, N, E, Y]).', Quindi ricevo come associazioni di variabili: 'M = 1, O = 0, S = 9', quindi 3 variabili sono prontamente fissate agli interi in calcestruzzo già semplicemente pubblicando i vincoli CLP (FD) che descrivono il puzzle. Anche i domini delle variabili rimanenti sono ridotti, come vediamo dagli obiettivi residui: 'N in 5..8, E in 4..7, R in 2..8, Y in 2..8'. Una fase di ricerca finale trova la soluzione univoca come binding di interi in calcestruzzo per tutte le variabili CLP (FD). – mat

6

Considerare l'utilizzo finite domain constraints, per esempio, in SWI-Prolog: query

:- 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. 

Esempio:

?- 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. 
4

Scadente prestazioni qui è dovuto alla formazione di tutte le possibili assegnazioni delle lettere prima di verificare se ne sono fattibili .

Il mio consiglio è "fallire presto, fallire spesso". Cioè, spingere quanti più controlli per l'errore il più presto possibile nei passaggi di assegnazione, quindi potendo l'albero di ricerca.

Klas Lindbäck offre alcuni buoni suggerimenti. Come generalizzazione, quando si aggiungono due numeri il carry è al massimo uno in ogni posto. Quindi l'assegnazione di cifre distinte alle lettere da sinistra a destra può essere verificata tenendo conto della possibilità di un trasporto ancora non determinato nei posti più a destra. (Ovviamente nel posto finale "unità", non c'è trasporto.)

E 'molto da pensare, che è il motivo per cui la logica di vincolo, come suggerisce mat (e che hai già affrontato con fd_all_different/1), è una tale convenienza.


Aggiunto: Ecco una soluzione Prolog senza logica vincolo, utilizzando un solo predicato ausiliario omettere/3:

omit(H,[H|T],T). 
omit(X,[H|T],[H|Y]) :- omit(X,T,Y). 

cui entrambi seleziona un elemento da un elenco e produce l'elenco abbreviato senza quell'elemento.

Ecco allora è il codice per sendMoreMoney/3 che cerca valutando la somma da sinistra a destra:

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,_). 

Scendiamo ad un inizio rapido osservando che M deve essere il riporto non nulla da la somma delle cifre più a sinistra, quindi 1, e S deve essere un'altra cifra diversa da zero. I commenti mostrano i passaggi in cui lettere aggiuntive possono essere assegnate in modo deterministico ai valori in base alle scelte già effettuate.


Aggiunto (2): Ecco una "generale" risolutore cryptarithm per due addendi, che non ha bisogno di avere la stessa lunghezza/numero di "posti". Codice per lunghezza/2 viene omesso come un predicato built-in abbastanza comune, e prendendo il suggerimento da Will Ness, chiama a omettere/3 sono sostituiti dai selezionare/3 per convenienza degli utenti di SWI-Prolog.

L'ho provato con Amzi! e SWI-Prolog utilizzano questi esempi alphametics from Cryptarithms.com che prevedono due riassunti, ognuno dei quali ha una soluzione unica. Ho anche fatto un esempio con una dozzina di soluzioni, I + AM = BEN, per testare il giusto backtracking.

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___). 

penso che questo dimostra che i vantaggi della sinistra a destra di ricerca/valutazione può essere raggiunto in un risolutore "generalizzato", aumentando il numero di inferenze di circa un fattore due rispetto al precedente " codice "su misura".

+0

il tuo omit/3' è SWI-Prolog ['select/3'] (http://www.swi-prolog.org/pldoc/doc_for?object=select/3). Variamente noto come 'del/3',' delete/3' ecc. Usarlo consente la manipolazione diretta di domini finiti (o "pool"). Il predicato 'selectM/3' della mia risposta racchiude più invocazioni di' select/3' in una, per una codifica più semplice e molto più breve. Inoltre, il tuo codice impiega un sacco di ragionamento umano. –

+0

@WillNess: È vero che SWI-Prolog ha quel predicato (equivalente) come un built-in. Stavo cercando di illustrare i vantaggi della valutazione da sinistra a destra, che grazie alla tua versione da destra a sinistra, possiamo confrontare. – hardmath

+0

Così ho provato la tua versione e ci sono volute 533 (676) inferenze/0,00 secondi, contro 27.653 (38.601) inferenze/0.02 secondi che la mia versione richiede. :) Questo non è sorprendente considerando la quantità di ragionamento umano che entra nel tuo codice, che è molto più difficile da formalizzare in confronto (che è ciò che la Q originale è, dopo tutto). L'articolo WP, ad es. arriva alla soluzione completa senza alcun codice, portando quel ragionamento umano un po 'più lontano. –

2

Si hanno

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 

Così, si può esprimere questo con un semplice ricorsività lineare.

più importante, quando si sceglie una possibile cifre dal tuo dominio 0..9, non si dovrebbe utilizzare tale cifra più per le scelte successive:

selectM([A|As],S,Z):- select(A,S,S1),selectM(As,S1,Z). 
selectM([],Z,Z). 

select/3 è disponibile in SWI Prolog. Armati di questo strumento, è possibile selezionare le cifre a poco a poco dal vostro restringendo così dominio:

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. 

Possiamo aggiungere due cifre con un riporto, aggiunge produrre una cifra risultante con nuovo trasporto (ad esempio, vale a dire 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 . 

Così attuato, money_puzzle/1 piste istantaneamente, grazie alla natura graduale in cui le cifre vengono raccolti e testati subito:

?- 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) 

La sfida diventa ora per renderlo generico .

+0

s (X) e sfida accettata! – CapelliC

2

Ecco il mio punto di vista. Io uso , , e 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). 

Mettiamola mapfoldl/5 a buon uso e fare un po 'di aritmetica verbale!

:- 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). 

rapido e sporco hack per scaricare tutte le soluzioni trovati:

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). 

Proviamo!

 
?- 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]. 
true. 

?- 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]. 
true. 

?- 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]. 
true. 

?- 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]. 
true. 

?- solve_n_dump([N,U,M,B,E,R] #= 3*[P,R,I,M,E]). 
% same as:  [N,U,M,B,E,R] #= [P,R,I,M,E]+[P,R,I,M,E]+[P,R,I,M,E] 
Eq = (3*[5,4,3,2,8]#=[1,6,2,9,8,4]), Zs = [5,4,3,2,8,1,6,9]. 
true. 

?- 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]. 
true. 

Facciamo un po 'di più e provare un po' diverso 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 inferences, 3.929 CPU in 3.928 seconds (100% CPU, 9085480 Lips) 
true. 

?- 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 inferences, 0.340 CPU in 0.340 seconds (100% CPU, 8533271 Lips) 
true. 
1

Will Ness stile, generalizzata (ma assumendo length(A) <= length(B)) risolutore:

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. 

prestazioni:

?- 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.