Related
What I want is something like merge(Dict1, Dict2, Merged) that behaves like the following:
?- merge(counter{a: 1, b: 2}, counter{a: 3, c: 4, d: 5}, Merged).
Merged = counter{a: 4, b: 2, c: 4, d: 5}
What should I do to achieve this? I'm totally new to logic programming, so I end up failing trying to write something that looks like a terrible port of for loop of other languages.
dicts_merge_add(Dict1, Dict2, DictMerged) :-
% Convert to sorted key-value pairs
dict_pairs(Dict1, Tag, Pairs1),
dict_pairs(Dict2, Tag, Pairs2),
% Merge the pairs
pairs_merge_add(Pairs1, Pairs2, PairsMerged),
% Convert to dict
dict_pairs(DictMerged, Tag, PairsMerged).
% When reached end of 1 list, insert the remains of the other list
pairs_merge_add([], T, T) :- !.
pairs_merge_add(T, [], T) :- !.
pairs_merge_add([K-V1|T1], [K-V2|T2], L) :-
% Keys are same
!,
Sum is V1 + V2,
L = [K-Sum|Merg],
pairs_merge_add(T1, T2, Merg).
pairs_merge_add([K1-V1|T1], [K2-V2|T2], L) :-
K1 #< K2,
!,
L = [K1-V1|Merg],
pairs_merge_add(T1, [K2-V2|T2], Merg).
pairs_merge_add([K1-V1|T1], [K2-V2|T2], L) :-
K1 #> K2,
!,
L = [K2-V2|Merg],
pairs_merge_add([K1-V1|T1], T2, Merg).
Result in swi-prolog:
?- D1 = counter{a: 1, b: 2, z:6},
D2 = counter{a: 3, c: 4, z:8, d: 5},
time(dicts_merge_add(D1, D2, Merg)).
% 17 inferences, 0.000 CPU in 0.000 seconds (88% CPU, 389265 Lips)
D1 = counter{a:1,b:2,z:6},
D2 = counter{a:3,c:4,d:5,z:8},
Merg = counter{a:4,b:2,c:4,d:5,z:14}.
Simple performance test:
?- C = 30_000, numlist(1, C, L1N),
findall(N-N, member(N, L1N), L1),
dict_pairs(D1, v, L1), numlist(1, C, L2N),
findall(N-N, member(N, L2N), L2), dict_pairs(D2, v, L2),
time(merge(D1, D2, D3)), sleep(10).
% 180,005 inferences, 5.475 CPU in 5.486 seconds (100% CPU, 32877 Lips)
Vs mine: time(dicts_merge_add(D1, D2, D3))
% 60,005 inferences, 0.012 CPU in 0.012 seconds (100% CPU, 4987461 Lips)
This shows the huge performance advantage from using the fact that the lists are sorted.
This approach gets the entries from A, recurses over them and merges them into B:
merge(A, B, Merged) :-
dict_pairs(A, _, Pairs), % Pairs are an ordered set
merge_(Pairs, B, Merged).
merge_([], Merged, Merged). % No more pairs, merge finished.
merge_([K-V|Ps], B, Merged) :- % Merge Key-Value from A.
(get_dict(K, B, Bval) -> % Get the matching item from B.
Sum is V + Bval % if success, sum their values.
; Sum is V), % if not, just the value from A.
put_dict(K, B, Sum, B_), % merge into B.
merge_(Ps, B_, Merged). % merge remaining pairs into B.
On SWISH:
?- _D1 = counter{a: 1, b: 2, z:6},
_D2 = counter{a: 3, c: 4, z:8, d: 5},
time(merge(_D1, _D2, Merg)).
Merg = counter{a:4, b:2, c:4, d:5, z:14}
19 inferences, 0.000 CPU in 0.000 seconds (116% CPU, 827526 Lips)
Ieed to select a sublist from the list, from K to N indexes.
Example:
?- sublist(2, 5, [1, 2, 3, 4, 5, 6, 7, 8, 9], Res)
Res = [2, 3, 4, 5]
Given both integers K and N, you may use length/2 and append/3:
sublist(K, N, L, SL):-
N >= K,
length(L1, N), % L1 is a list with N elements
length([_|L2], K), % and L2 has K-1 elements.
append(L2, SL, L1), % Therefore SL has the last N-K+1 elements of L1
append(L1, _, L). % and L starts with L1 and may have some other elements after
Sample run:
?- sublist(2, 5, [1, 2, 3, 4, 5, 6, 7, 8, 9], Res).
Res = [2, 3, 4, 5].
sublist(StartPos, EndPos, Lst, SubLst) :-
% Check for sensible inputs
must_be(integer, StartPos),
must_be(integer, EndPos),
StartPos >= 1,
EndPos >= StartPos,
% Loop through the list
sublist_(Lst, StartPos, EndPos, 1, SubLst).
sublist_(Lst, StartPos, EndPos, StartPos, SubLst) :-
!,
% At start of sublist
sublist_within_(Lst, StartPos, EndPos, StartPos, SubLst).
sublist_(Lst, StartPos, EndPos, Pos, SubLst) :-
% Otherwise, is before the start of the sublist
Pos1 is Pos + 1,
% Don't care about the current element in the list
Lst = [_|Tail],
sublist_(Tail, StartPos, EndPos, Pos1, SubLst).
sublist_within_(Lst, StartPos, EndPos, Pos, SoFar) :-
Pos < EndPos,
% Within the sublist
!,
Pos1 is Pos + 1,
% Remember the current element in the list (in the correct order)
Lst = [Head|Tail],
SoFar = [Head|SubLst],
sublist_within_(Tail, StartPos, EndPos, Pos1, SubLst).
% End of the sublist - instantiate the end of SubLst
sublist_within_([Head|_], _StartPos, EndPos, EndPos, [Head]).
Result in swi-prolog:
?- time(sublist(2, 5, [1, 2, 3, 4, 5, 6, 7, 8, 9], Res)).
% 17 inferences, 0.000 CPU in 0.000 seconds (91% CPU, 514388 Lips)
Res = [2,3,4,5].
A smaller but slower alternative is:
sublist_slow(StartPos, EndPos, Lst, SubLst) :-
succ(BeforeLen, StartPos),
SubLstLen is EndPos - StartPos + 1,
length(BeforeLst, BeforeLen),
length(SubLst, SubLstLen),
% append is slow because it needs to iterate through the entire list
append([BeforeLst, SubLst, _AfterLst], Lst),
% Don't look for other potentials for _AfterLst
!.
But the "append" method has the disadvantage of having to iterate through the rest of the list, whereas the first method can stop at the end of SubLst - performance comparison:
test_sublists :-
numlist(1, 1000000, NL),
time(sublist(2, 5, NL, _)),
time(sublist_slow(2, 5, NL, _)).
Result in swi-prolog:
?- test_sublists.
% 17 inferences, 0.000 CPU in 0.000 seconds (90% CPU, 460256 Lips)
% 2,000,015 inferences, 0.249 CPU in 0.247 seconds (101% CPU, 8016137 Lips)
gusbro's method is in the middle, performance-wise:
test_sublists2 :-
numlist(1, 1000000, NL),
I = 100000,
time(sublist(I, I, NL, _)),
time(sublist_gusbro(I, I, NL, _)),
time(sublist_slow(I, I, NL, _)).
Performance result:
?- test_sublists2.
% 100,009 inferences, 0.011 CPU in 0.011 seconds (100% CPU, 8970530 Lips)
% 200,009 inferences, 0.015 CPU in 0.015 seconds (100% CPU, 13718721 Lips)
% 1,900,020 inferences, 0.198 CPU in 0.196 seconds (101% CPU, 9585032 Lips)
Here is a variant of Evgeny's code, with improved performance and termination:
sublist_evgeny(St, En, [_ | T], SubT) :-
St > 1, !,
% Move closer to the start element
St0 is St - 1,
En0 is En - 1,
sublist_evgeny(St0, En0, T, SubT).
sublist_evgeny(1, 0, _, SL) :-
!,
% Finished - the remaining sublist will be empty
SL = [].
sublist_evgeny(1, En, [H | T], [H | SubT]) :-
% Populate the sublist
En0 is En - 1,
sublist_evgeny(1, En0, T, SubT).
Performance is great:
% 200,001 inferences, 0.010 CPU in 0.010 seconds (100% CPU, 19344211 Lips)
Here is solution without any library functions:
sublist(1, 0, _, []).
sublist(A, B, [H | T], [H | SubT]) :-
A = 1,
B1 is B - 1,
sublist(A, B1, T, SubT).
sublist(A, B, [_ | T], SubT) :-
A > 1,
A1 is A - 1,
B1 is B - 1,
sublist(A1, B1, T, SubT).
I want to write predicate that generates the Fibonacci series for given N.
fibon(6, X) -> X = [0,1,1,2,3,5].
I have a predicate to generate the N-th element of the Fibonacci series:
fib(0, 0).
fib(1, 1).
fib(N, F) :-
N > 1,
N1 is N - 1,
N2 is N - 2,
fib(N1, F1),
fib(N2, F2),
F is F1 + F2.
And I try to write fibon/2, but it doesn't work:
fibon(N, [H|T]) :-
fib(N, H),
N1 is N - 1,
fibon(N1, T).
I solved it like the following:
at_the_end(X, [], [X]).
at_the_end(X, [H|T], [H|T2]) :-
at_the_end(X, T, T2).
revert([], []).
revert([H|T], Out) :-
revert(T, Out1),
at_the_end(H, Out1, Out).
fib(0, 0).
fib(1, 1).
fib(N, F) :-
N > 1,
N1 is N - 1,
N2 is N - 2,
fib(N1, F1),
fib(N2, F2),
F is F1 + F2.
fibon(0, [0]).
fibon(N, [H|T]) :-
fib(N, H),
N1 is N - 1,
fibon(N1, T).
fibonacci(In, Out) :-
fibon(In, Out1),
revert(Out1, Out).
You can squeeze out a little more speed by making the recursive predicate tail recursive:
fib_seq(0,[0]). % <- base case 1
fib_seq(1,[0,1]). % <- base case 2
fib_seq(N,Seq) :-
N > 1,
fib_seq_(N,SeqR,1,[1,0]), % <- actual relation (all other cases)
reverse(SeqR,Seq). % <- reverse/2 from library(lists)
fib_seq_(N,Seq,N,Seq).
fib_seq_(N,Seq,N0,[B,A|Fs]) :-
N > N0,
N1 is N0+1,
C is A+B,
fib_seq_(N,Seq,N1,[C,B,A|Fs]). % <- tail recursion
First let's observe that your example query works as expected:
?- fib_seq(6,L).
L = [0, 1, 1, 2, 3, 5, 8] ;
false.
Note that the list doesn't have six elements, as in your example at the beginning of your post, but seven. This is because the predicate starts counting at zero (BTW this is the same behaviour as that of the predicate fibonacci/2 that you added to your post).
For comparison (with fib/2 from #Enigmativity's post) reasons, let's either remove the goal reverse/2 from fib_seq/2 (then you'd get all solutions except N=0 and N=1 in reverse order):
?- time((fib(50000,L),false)).
% 150,001 inferences, 0.396 CPU in 0.396 seconds (100% CPU, 379199 Lips)
false.
?- time((fib_seq(50000,L),false)).
% 150,002 inferences, 0.078 CPU in 0.078 seconds (100% CPU, 1930675 Lips)
false.
Or leave fib_seq/2 as it is and measure fib/2 with an additional goal reverse/2 (then R in the fib/2 solution corresponds to L in the fib_seq/2 solution):
?- time((fib(50000,L),reverse(L,R),false)).
% 200,004 inferences, 0.409 CPU in 0.409 seconds (100% CPU, 488961 Lips)
false.
?- time((fib_seq(50000,L),false)).
% 200,005 inferences, 0.088 CPU in 0.088 seconds (100% CPU, 2267872 Lips)
false.
On a side note, I would urge you to compare your predicate fibonacci/2 with the posted solutions when trying to get bigger lists, say N > 30.
If you're happy to reverse the order of the results for the sequence then this works:
fib(0, [0]).
fib(1, [1,0]).
fib(N, [R,X,Y|Zs]) :-
N > 1,
N1 is N - 1,
fib(N1, [X,Y|Zs]),
R is X + Y.
Then ?- fib(15,Z). gives me [610, 377, 233, 144, 89, 55, 34, 21, 13, 8, 5, 3, 2, 1, 1, 0].
It would be easy to throw in a reverse/3 predicate:
reverse([],Z,Z).
reverse([H|T],Z,A) :- reverse(T,Z,[H|A]).
Just for fun using scanl. and some standard dcgs.
:-use_module(library(clpfd)).
my_plus(X,Y,Z):-
Z#>=0,
Z#=<1000, % Max size optional
Z#=X+Y.
list([]) --> [].
list([L|Ls]) --> [L], list(Ls).
concatenation([]) --> [].
concatenation([List|Lists]) -->
list(List),
concatenation(Lists).
fib(Len,List1):-
X0=1,
length(List1,Len),
length(End,2),
MiddleLen #= Len - 3,
length(Middle,MiddleLen),
phrase(concatenation([[X0],Middle,End]), List1),
phrase(concatenation([[X0],Middle]), List2),
phrase(concatenation([Middle,End]), List3),
scanl(my_plus,List2,X0,List3).
If you want to collect a list of the first N elements of the Fibonacci series you can use the rule below. Just remember to initialize the first 2 predicates.
fib(0, [1]).
fib(1, [1, 1]).
fib(N, L) :-
N > 1,
N1 is N - 1,
N2 is N - 2,
fib(N1, F1),
last(F1, L1),
fib(N2, F2),
last(F2, L2),
L_new is L1 + L2,
append(F1, [L_new], L).
I am doing this problem but I am completely new to Prolog and I have no idea how to do it.
Nine parts of an electronic board have square shape, the same size and each edge of every part is marked with a letter and a plus or minus sign. The parts are to be assembled into a complete board as shown in the figure below such that the common edges have the same letter and opposite signs. Write a planner in Prolog such that the program takes 'assemble' as the query and outputs how to assemble the parts, i.e. determine the locations and positions of the parts w.r.t. the current positions so that they fit together to make the complete board.
I have tried solving it and I have written the following clauses:
complement(a,aNeg).
complement(b,bNeg).
complement(c,cNeg).
complement(d,dNeg).
complement(aNeg,a).
complement(bNeg,b).
complement(cNeg,c).
complement(dNeg,d).
% Configuration of boards, (board,left,top,right,bottom)
conf(b1,aNeg,bNeg,c,d).
conf(b2,bNeg,a,d,cNeg).
conf(b3,dNeg,cNeg,b,d).
conf(b4,b,dNeg,cNeg,d).
conf(b5,d,b,cNeg,aNeg).
conf(b6,b,aNeg,dNeg,c).
conf(b7,aNeg,bNeg,c,b).
conf(b8,b,aNeg,cNeg,a).
conf(b9,cNeg,bNeg,a,d).
position(b1,J,A).
position(b2,K,B).
position(b3,L,C).
position(b4,M,D).
position(b5,N,E).
position(b6,O,F).
position(b7,P,G).
position(b8,Q,H).
position(b9,R,I).
assemble([A,B,C,E,D,F,G,H,I,J,K,L,M,N,O,P,Q,R]) :-
Variables=[(A,J),(B,K),(C,L),(D,M),(E,N),(F,O),(G,P),(H,Q),(I,R)],
all_different(Variables),
A in 1..3, B in 1..3, C in 1..3, D in 1..3, E in 1..3,
F in 1..3, G in 1..3, H in 1..3, I in 1..3, J in 1..3,
K in 1..3, L in 1..3, M in 1..3, N in 1..3, O in 1..3,
P in 1..3, Q in 1..3, R in 1..3,
% this is where I am stuck, what to write next
I don't know even if they are correct and I am not sure how to proceed further to solve this problem.
Trivial with CLP(FD):
:- use_module(library(clpfd)).
board(Board) :-
Board = [[A1,A2,A3],
[B1,B2,B3],
[C1,C2,C3]],
maplist(top_bottom, [A1,A2,A3], [B1,B2,B3]),
maplist(top_bottom, [B1,B2,B3], [C1,C2,C3]),
maplist(left_right, [A1,B1,C1], [A2,B2,C2]),
maplist(left_right, [A2,B2,C2], [A3,B3,C3]),
pieces(Ps),
maplist(board_piece(Board), Ps).
top_bottom([_,_,X,_], [Y,_,_,_]) :- X #= -Y.
left_right([_,X,_,_], [_,_,_,Y]) :- X #= -Y.
pieces(Ps) :-
Ps = [[-2,3,4,-1], [1,4,-3,-4], [-3,2,4,-4],
[-4,-3,4,2], [2,-3,-1,4], [-1,-4,3,2],
[-2,3,2,-1], [-1,-3,1,2], [-2,1,4,-3]].
board_piece(Board, Piece) :-
member(Row, Board),
member(Piece0, Row),
rotation(Piece0, Piece).
rotation([A,B,C,D], [A,B,C,D]).
rotation([A,B,C,D], [B,C,D,A]).
rotation([A,B,C,D], [C,D,A,B]).
rotation([A,B,C,D], [D,A,B,C]).
Example query and its result:
?- time(board(Bs)), maplist(writeln, Bs).
11,728,757 inferences, 0.817 CPU in 0.817 seconds
[[-3, -4, 1, 4], [-1, -2, 3, 4], [4, -4, -3, 2]]
[[-1, 4, 2, -3], [-3, 4, 2, -4], [3, 2, -1, -4]]
[[-2, 1, 4, -3], [-2, 3, 2, -1], [1, 2, -1, -3]]
This representation uses 1,2,3,4 to denote positive a,b,c,d, and -1,-2,-3,-4 for the negative ones.
This is only a tiny improvement to #mat's beautiful solution. The idea is to reconsider the labeling process. That is maplist(board_piece,Board,Ps) which reads (semi-procedurally):
For all elements in Ps, thus for all pieces in that order: Take one piece and place it anywhere on the board rotated or not.
This means that each placement can be done in full liberty. To show you a weak order, one might take: A1,A3,C1,C3,B2 and then the rest. In this manner, the actual constraints are not much exploited.
However, there seems to be no good reason that the second tile is not placed in direct proximity to the first. Here is such an improved order:
...,
pieces(Ps),
TilesOrdered = [B2,A2,A3,B3,C3,C2,C1,B1,A1],
tiles_withpieces(TilesOrdered, Ps).
tiles_withpieces([], []).
tiles_withpieces([T|Ts], Ps0) :-
select(P,Ps0,Ps1),
rotation(P, T),
tiles_withpieces(Ts, Ps1).
Now, I get
?- time(board(Bs)), maplist(writeln, Bs).
% 17,179 inferences, 0.005 CPU in 0.005 seconds (99% CPU, 3363895 Lips)
[[-3,1,2,-1],[-2,3,2,-1],[2,4,-4,-3]]
[[-2,1,4,-3],[-2,3,4,-1],[4,2,-4,-3]]
[[-4,3,2,-1],[-4,1,4,-3],[4,2,-3,-1]]
and without the goal maplist(maplist(tile), Board),
% 11,010 inferences, 0.003 CPU in 0.003 seconds (100% CPU, 3225961 Lips)
and to enumerate all solutions
?- time((setof(Bs,board(Bs),BBs),length(BBs,N))).
% 236,573 inferences, 0.076 CPU in 0.154 seconds (49% CPU, 3110022 Lips)
BBs = [...]
N = 8.
previously (#mat's original version) the first solution took:
% 28,874,632 inferences, 8.208 CPU in 8.217 seconds (100% CPU, 3518020 Lips)
and all solutions:
% 91,664,740 inferences, 25.808 CPU in 37.860 seconds (68% CPU, 3551809 Lips)
In terms of performance, the following is no contender to #false's very fast solution.
However, I would like to show you a different way to formulate this, so that you can use the constraint solver to approximate the faster allocation strategy that #false found manually:
:- use_module(library(clpfd)).
board(Board) :-
Board = [[A1,A2,A3],
[B1,B2,B3],
[C1,C2,C3]],
maplist(top_bottom, [A1,A2,A3], [B1,B2,B3]),
maplist(top_bottom, [B1,B2,B3], [C1,C2,C3]),
maplist(left_right, [A1,B1,C1], [A2,B2,C2]),
maplist(left_right, [A2,B2,C2], [A3,B3,C3]),
pieces(Ps0),
foldl(piece_with_id, Ps0, Pss, 0, _),
append(Pss, Ps),
append(Board, Bs0),
maplist(tile_with_var, Bs0, Bs, Vs),
all_distinct(Vs),
tuples_in(Bs, Ps).
tile_with_var(Tile, [V|Tile], V).
top_bottom([_,_,X,_], [Y,_,_,_]) :- X #= -Y.
left_right([_,X,_,_], [_,_,_,Y]) :- X #= -Y.
pieces(Ps) :-
Ps = [[-2,3,4,-1], [1,4,-3,-4], [-3,2,4,-4],
[-4,-3,4,2], [2,-3,-1,4], [-1,-4,3,2],
[-2,3,2,-1], [-1,-3,1,2], [-2,1,4,-3]].
piece_with_id(P0, Ps, N0, N) :-
findall(P, (rotation(P0,P1),P=[N0|P1]), Ps),
N #= N0 + 1.
rotation([A,B,C,D], [A,B,C,D]).
rotation([A,B,C,D], [B,C,D,A]).
rotation([A,B,C,D], [C,D,A,B]).
rotation([A,B,C,D], [D,A,B,C]).
You can now use the "first fail" strategy of CLP(FD) and try the most constrained elements first. With this formulation, the time needed to find all 8 solutions is:
?- time(findall(t, (board(B), term_variables(B, Vs), labeling([ff],Vs)), Ts)).
2,613,325 inferences, 0.208 CPU in 0.208 seconds
Ts = [t, t, t, t, t, t, t, t].
In addition, I would like to offer the following contender for the speed contest, which I obtained with an extensive partial evaluation of the original program:
solution([[[-4,-3,2,4],[2,-1,-4,3],[2,-1,-3,1]],[[-2,3,4,-1],[4,2,-4,-3],[3,2,-1,-2]],[[-4,1,4,-3],[4,2,-3,-1],[1,4,-3,-2]]]).
solution([[[-3,-4,1,4],[-1,-2,3,4],[4,-4,-3,2]],[[-1,4,2,-3],[-3,4,2,-4],[3,2,-1,-4]],[[-2,1,4,-3],[-2,3,2,-1],[1,2,-1,-3]]]).
solution([[[-3,-2,1,4],[-3,-1,4,2],[4,-3,-4,1]],[[-1,-2,3,2],[-4,-3,4,2],[4,-1,-2,3]],[[-3,1,2,-1],[-4,3,2,-1],[2,4,-4,-3]]]).
solution([[[-3,1,2,-1],[-2,3,2,-1],[2,4,-4,-3]],[[-2,1,4,-3],[-2,3,4,-1],[4,2,-4,-3]],[[-4,3,2,-1],[-4,1,4,-3],[4,2,-3,-1]]]).
solution([[[-3,-1,4,2],[4,-3,-4,1],[2,-1,-4,3]],[[-4,-3,4,2],[4,-1,-2,3],[4,-3,-2,1]],[[-4,-3,2,4],[2,-1,-2,3],[2,-1,-3,1]]]).
solution([[[-1,-3,1,2],[2,-1,-2,3],[4,-3,-2,1]],[[-1,-4,3,2],[2,-4,-3,4],[2,-3,-1,4]],[[-3,2,4,-4],[3,4,-1,-2],[1,4,-3,-4]]]).
solution([[[-1,-4,3,2],[-3,-2,1,4],[-1,-3,1,2]],[[-3,-4,1,4],[-1,-2,3,4],[-1,-2,3,2]],[[-1,4,2,-3],[-3,4,2,-4],[-3,2,4,-4]]]).
solution([[[4,-4,-3,2],[2,-4,-3,4],[2,-3,-1,4]],[[3,2,-1,-2],[3,4,-1,-2],[1,4,-3,-4]],[[1,2,-1,-3],[1,4,-3,-2],[3,2,-1,-4]]]).
The 8 solutions are found very rapidly with this formulation:
?- time(findall(t, solution(B), Ts)).
19 inferences, 0.000 CPU in 0.000 seconds
Ts = [t, t, t, t, t, t, t, t].
I have been asked to solve a Cryptarithmetic Puzzle using Prolog:
GIVE
* ME
------
MONEY
The above is the puzzle, I cannot figure out where is the problem, the result always returns false. Plus I am not allowed to use any library in SWI-Prolog.
solve(Z) :-
assign(Z,[0,1,2,3,4,5,6,7,8,9]),
check(Z).
find( VAL , G,I,V,E ) :- VAL is G * 1000 + I * 100 + V * 10 + E.
find2(VALR, M,E ) :- VALR is M * 10 + E.
find3(VALA, M,O,N,E,Y) :- VALA is M * 10000 + O * 1000 + N * 100 + E * 10 + Y.
check(Z) :-
G #>= 1,
M #>= 1,
find( VAL, G,I,V,E),
find2(VALR, M,E),
find3(VALA, M,O,N,E,Y),
VAL * VALR =:= VALA.
assign(Z,L) :-
permute(L,Z).
/* permute is similar to all_different in swi-prolog */
addany(X,K,[X|K]).
addany(X,[F|K],[F|L1]) :-
addany(X,K,L1).
permute([],[]).
permute([X|K],P) :-
permute(K,L1),
addany(X,L1,P).
Sample query:
?- solve([G,I,V,E,M,O,N,Y]).
false. % fails unexpectedly
Let's get right to the heart of the matter!
Every permutation of
[0,1,2,3,4,5,6,7,8,9] is a list of length 10.
[G,I,V,E,M,O,N,Y] is a list of length 8.
No permutation of [0,1,2,3,4,5,6,7,8,9] can be unified with [G,I,V,E,M,O,N,Y].
As a quick-fix, adapt the definition of check/1 like this:
check([G,I,V,E,M,O,N,Y,_,_]) :-
find( VAL, G,I,V,E),
G >= 1,
find2(VALR, M,E),
M >= 1,
find3(VALA, M,O,N,E,Y),
VAL * VALR =:= VALA.
Then, run the following "fixed" query:
?- Expr = ([G,I,V,E]*[M,E] = [M,O,N,E,Y]),
Zs = [G,I,V,E,M,O,N,Y,_,_],
time(solve(Zs)).
% 24,641,436 inferences, 7.692 CPU in 7.709 seconds (100% CPU, 3203506 Lips)
Expr = ([1,0,7,2] * [9,2] = [9,8,6,2,4]),
Zs = [1,0,7,2,9,8,6,4,3,5] ;
% 7,355 inferences, 0.007 CPU in 0.007 seconds (100% CPU, 1058235 Lips)
Expr = ([1,0,7,2] * [9,2] = [9,8,6,2,4]), % redundant
Zs = [1,0,7,2,9,8,6,4,5,3] ;
% 6,169,314 inferences, 1.935 CPU in 1.939 seconds (100% CPU, 3188312 Lips)
Expr = ([1,0,9,2] * [7,2] = [7,8,6,2,4]),
Zs = [1,0,9,2,7,8,6,4,3,5] ;
% 7,355 inferences, 0.005 CPU in 0.005 seconds (99% CPU, 1360603 Lips)
Expr = ([1,0,9,2] * [7,2] = [7,8,6,2,4]), % redundant
Zs = [1,0,9,2,7,8,6,4,5,3] ;
% 6,234,555 inferences, 1.955 CPU in 1.959 seconds (100% CPU, 3189462 Lips)
false.
Here's another way to solve the problem:
First, use clpfd!
:- use_module(library(clpfd)).
Second, (re-)use code presented earlier in my answer
to the related question Faster implementation of verbal arithmetic in Prolog:
?- Expr = ([G,I,V,E] * [M,E] #= [M,O,N,E,Y]),
Zs = [G,I,V,E,M,O,N,Y],
crypt_arith_(Expr,Zs),
time(labeling([],Zs)).
% 397,472 inferences, 0.088 CPU in 0.088 seconds (100% CPU, 4521899 Lips)
Expr = ([1,0,7,2] * [9,2] #= [9,8,6,2,4]), Zs = [1,0,7,2,9,8,6,4] ;
% 128,982 inferences, 0.037 CPU in 0.037 seconds (100% CPU, 3502788 Lips)
Expr = ([1,0,9,2] * [7,2] #= [7,8,6,2,4]), Zs = [1,0,9,2,7,8,6,4] ;
% 77,809 inferences, 0.028 CPU in 0.028 seconds (100% CPU, 2771783 Lips)
false.
No redundant solutions. Orders of magnitude faster than "generate & test". clpfd rocks!
The following article by Eric Weisstein and Ed Pegg will be useful. It offers several solutions for a similar problem in Mathematica.
Using a very brute-force approach, there are two solutions: 1072 * 92 = 98624 and 1092 * 72 = 78624. The code that I used:
In[16]:= Cases[
Permutations[
Range[0, 9], {5}], {g_, i_, v_, e_, m_} /; g > 0 && m > 0 :>
With[{dig = IntegerDigits[(g*10^3 + i*10^2 + v*10 + e) (10 m + e)]},
Join[{g, i, v, e, m}, dig[[{2, 3, 5}]]] /;
And[Length[dig] == 5, Unequal ## dig, dig[[{1, 4}]] == {m, e},
Intersection[dig[[{2, 3, 5}]], {g, i, v, e, m}] === {} ]
]]
Out[16]= {{1, 0, 7, 2, 9, 8, 6, 4}, {1, 0, 9, 2, 7, 8, 6, 4}}