I am trying to construct the shortest path between multiple nodes that are doubly connected. Like so:
A->B
B->A
A->C
C->A
A->D
D->A
D->X
X->Y
Y->X
X->Z
Z->X
They are also assigned costs to figure out the shortest path.
My issue here is that my prolog program always ends up going in circles when constructing a path from A->Z
Here is my code:
connected(a,b,10).
connected(b,a,10).
connected(a,c,10).
connected(c,a,10).
connected(a,d,10).
connected(d,a,10).
connected(d,x,20).
connected(x,y,10).
connected(y,x,10).
connected(z,x,10).
connected(x,z,10).
path(A,B,Path,C):-
connected(A,B,C).
path(A,B,Path,C):-
connected(X,B,C1),
PathN = [X | Path],
path(A,X,PathN,C2),
C is C1+C2,
Path = PathN.
Trace output of session:
Redo: (18) path(a, b, [b, a, b, a, b, a, d, x|...], _10100) ? creep
Call: (19) connected(_18442, b, _18444) ? creep
Exit: (19) connected(a, b, 10) ? creep
Call: (19) _19962=[a, b, a, b, a, b, a, d|...] ? creep
Exit: (19) [a, b, a, b, a, b, a, d|...]=[a, b, a, b, a, b, a, d|...] ? creep
Call: (19) path(a, a, [a, b, a, b, a, b, a, d|...], _21478) ? creep
Call: (20) connected(a, a, _21478) ? creep
Fail: (20) connected(a, a, _21478) ? creep
Redo: (19) path(a, a, [a, b, a, b, a, b, a, d|...], _21478) ? creep
Call: (20) connected(_24520, a, _24522) ? creep
Exit: (20) connected(b, a, 10) ? creep
Call: (20) _26040=[b, a, b, a, b, a, b, a|...] ? creep
Exit: (20) [b, a, b, a, b, a, b, a|...]=[b, a, b, a, b, a, b, a|...] ? creep
Call: (20) path(a, b, [b, a, b, a, b, a, b, a|...], _27556) ? creep
Call: (21) connected(a, b, _27556) ? creep
Exit: (21) connected(a, b, 10) ? creep
Exit: (20) path(a, b, [b, a, b, a, b, a, b, a|...], 10) ? creep
Call: (20) _21478 is 10+10 ? creep
Exit: (20) 20 is 10+10 ? creep
Call: (20) [a, b, a, b, a, b, a, d|...]=[b, a, b, a, b, a, b, a|...] ? creep
Fail: (20) [a, b, a, b, a, b, a, d|...]=[b, a, b, a, b, a, b, a|...] ? creep
Redo: (21) connected(a, b, _228) ? creep
Fail: (21) connected(a, b, _228) ? creep
Redo: (20) path(a, b, [b, a, b, a, b, a, b, a|...], _228) ? creep
Call: (21) connected(_3680, b, _3682) ? creep
Exit: (21) connected(a, b, 10) ? creep
Call: (21) _5200=[a, b, a, b, a, b, a, b|...] ? creep
Exit: (21) [a, b, a, b, a, b, a, b|...]=[a, b, a, b, a, b, a, b|...] ? creep
Call: (21) path(a, a, [a, b, a, b, a, b, a, b|...], _6716) ? creep
Call: (22) connected(a, a, _6716) ? creep
Fail: (22) connected(a, a, _6716) ? creep
Redo: (21) path(a, a, [a, b, a, b, a, b, a, b|...], _6716) ? creep
Call: (22) connected(_9758, a, _9760) ? creep
Exit: (22) connected(b, a, 10) ? creep
Call: (22) _11278=[b, a, b, a, b, a, b, a|...] ? creep
Exit: (22) [b, a, b, a, b, a, b, a|...]=[b, a, b, a, b, a, b, a|...] ? creep
Call: (22) path(a, b, [b, a, b, a, b, a, b, a|...], _12794) ? creep
Call: (23) connected(a, b, _12794) ? creep
Exit: (23) connected(a, b, 10) ? creep
Exit: (22) path(a, b, [b, a, b, a, b, a, b, a|...], 10) ? creep
Call: (22) _6716 is 10+10 ? creep
Exit: (22) 20 is 10+10 ? creep
Call: (22) [a, b, a, b, a, b, a, b|...]=[b, a, b, a, b, a, b, a|...] ? creep
Fail: (22) [a, b, a, b, a, b, a, b|...]=[b, a, b, a, b, a, b, a|...] ? creep
Redo: (23) connected(a, b, _12794) ? creep
Fail: (23) connected(a, b, _12794) ? creep
Redo: (22) path(a, b, [b, a, b, a, b, a, b, a|...], _12794) ?
It ends up going back and forth between A->B and B->A. While technically I understand that this is within the set of all possible paths, its not what I intent.
My question is, how can I instruct prolog to not consider such paths? Or at least eliminate the infinite loop or limit/constrict it? If I limit the list to length 10 for example, I still get way too many permutations of A->B,B->A within a list of length 10.
Not homework. I am learning prolog on my own and wish to understand it properly.
Edit:
I managed to restrict it the way I wanted using occurrences_of_term, now I am just having some trouble getting a proper output list:
path(A,B,_,C,_):-
connected(A,B,C).
path(A,B,L,C,Lout):-
connected(X,B,C1),
occurrences_of_term(X,L,Oc),
(Oc < 2 ->
(
path(A,X,[X|L],C2,Lout),
C is C1+C2
);
(
C is C1, Lout = L
)
).
Output:
?- path(a,z,X,C,R)
| .
C = 40 ;
C = 60 ;
C = 60,
R = [b, a, d, x|X] ;
C = 60 ;
C = 60,
R = [c, a, d, x|X] ;
C = 50,
R = [a, d, x|X] ;
C = 30,
R = [y, x|X] ;
C = 30,
R = [z, x|X].
Some help with cleaning up the stray [x|X] would be appreciated.
I found a possible solution to the problem, hope you find interesting insights.
path(A, B, Path, VisitedNodes, C):-
append([B], VisitedNodes, UpdatedNodes),
connected(X, B, C1),
maplist(\=(X), VisitedNodes), % X does not unify with any member of the list of Visited Nodes;
(
X= A, C is C1,
append([A, B], VisitedNodes, Path)
;
path(A, X, Path, UpdatedNodes, C2),
C is C1 + C2
).
find_path(StartNode, Dest):-
path(StartNode, Dest, Path, [], Cost),
atomic_list_concat(Path, ' -> ', PathDesc),
atomic_list_concat(["Cost of the path:: ", Cost, "\nPath sequence: ", PathDesc, "\n"], AtomDesc),
atom_string(AtomDesc, Desc), write(Desc).
Related
The program is to generate an alternating result of the list.
For example ,{5,6,1} would be 5-6+1.
alternate(L,X) :-
alternate(L,0,K,_).
alternate([],X,_,_).
alternate([H|T],A,p,S) :- !,
AA is A + H,
alternate(T,AA,m,S).
alternate([H|T],A,m,S) :- !,
AA is A - H,
alternate(T,AA,p,S).
The following is the tracing result:
alternate([5,6,1],S).
Call: (10) alternate([5, 6, 1], _11626) ? creep
Call: (11) alternate([5, 6, 1], 0, p, _12084) ? creep
Call: (12) _12128 is 0+5 ? creep
Exit: (12) 5 is 0+5 ? creep
Call: (12) alternate([6, 1], 5, m, _12222) ? creep
Call: (13) _12266 is 5-6 ? creep
Exit: (13) -1 is 5-6 ? creep
Call: (13) alternate([1], -1, p, _12360) ? creep
Call: (14) _12404 is -1+1 ? creep
Exit: (14) 0 is -1+1 ? creep
Call: (14) alternate([], 0, m, _12498) ? creep//I expect it to return the X = 0 here.
Exit: (14) alternate([], 0, m, _12542) ? creep
Exit: (13) alternate([1], -1, p, _12586) ? creep
Exit: (12) alternate([6, 1], 5, m, _12630) ? creep
Exit: (11) alternate([5, 6, 1], 0, p, _12674) ? creep
Exit: (10) alternate([5, 6, 1], _11626) ? creep
true.
I am using alternate([],X,,) to return X when there are no more elements, but I don't understand why it doesn't work.
If you reach the end of the list you need to short-circuit the so-far-computed value in the accumulator (second argument) into the "final result":
Instead of:
alternate([],X,_,_).
alternate([],X,_,X).
When starting off, start off with a p, and the accumlator at 0. On success, argument 4 will contain the final result:
alternate(L,X) :-
alternate(L,0,p,X).
And so:
alternate(L,X) :-
alternate(L,0,p,X).
alternate([],X,_,X).
alternate([H|T],A,p,S) :- !,
AA is A + H,
alternate(T,AA,m,S).
alternate([H|T],A,m,S) :- !,
AA is A - H,
alternate(T,AA,p,S).
?- alternate([1,2,3,4],X).
X = -2.
Bonus: As a DCG
This one is written in not-tail-recursive style so just needs to carry the "final sum" on each call, from which we compute a new "final sum" on predicate success:
alternate(List,Sum) :- phrase(alternate_p(Sum),List).
alternate_p(0) --> [].
alternate_p(Sum) --> [X], alternate_n(TailSum), { Sum is TailSum+X }.
alternate_n(0) --> [].
alternate_n(Sum) --> [X], alternate_p(TailSum), { Sum is TailSum-X }.
?- alternate([1,2,3,4],Sum).
Sum = -2 ; % any additional solutions?
false. % nope
Bonus: Using foldl/4
This being all about accumulating a value over a list in tail-recursive fashion, we can eschew writing the recursion ourselves, switch to "functional coding" and use foldl/4. We just need to write a predicate, here alternator/3 which gets called for each list element, gets "stuff" from "the left" and builds "new stuff" and shifts it "to the right". In our case, "stuff" is a pair [Sum,Multiplier]:
% alternator(Element,FromLeft,ToRight)
alternator(Element,[Sum,Multiplier],[NewSum,NewMultiplier]) :-
NewSum is Sum + Multiplier*Element,
NewMultiplier is Multiplier*(-1).
% alternate(List,Sum) is an application of foldl/4:
alternate(List,Sum) :-
foldl(alternator,List,[0,1],FoldlResult),
FoldlResult = [Sum,_FinalMultiplier].
Again:
?- alternate([1,2,3,4],Sum).
Sum = -2.
What I need to do is to write a predicate that takes a list of numbers and returns a list consisting of two elements, the first one is the sum of the even numbers and the second one the sum of the odd numbers.
For example:
?- sum([5,4,9,8,1,7], L).
L = [12, 22].
So far I have written:
iseven(N) :-
0 is mod(N,2).
Since you've defined iseven/2 you could use it like:
sum([],[0,0]).
sum([H|T],[N1,N2]):-
sum(T,[N3,N4]),
( iseven(H)
-> N1 is N3+H, N2 is N4
; N2 is N4+H, N1 is N3
).
Example:
?-sum([5,4,9,8,1,7], L).
L = [12, 22].
A non if-then-else version using different clauses:
sum([],[0,0]).
sum([H|T],[N1,N2]):- sum(T,[N3,N2]), iseven(H), N1 is N3+H.
sum([H|T],[N1,N2]):- sum(T,[N1,N3]), \+ iseven(H), N2 is N3+H.
You could also write this predicate using accumulators and if_/3. Furthermore you can incorporate the single goal of iseven/1 into the predicate:
list_sums(L,S) :-
list_sums_(L,S,0-0).
list_sums_([],[E,O],E-O).
list_sums_([X|Xs],S,E0-O0) :-
M is X mod 2,
if_(M=0,(E1 is E0+X, O1 is O0),(E1 is E0, O1 is O0+X)),
list_sums_(Xs,S,E1-O1).
Note how the accumulators are written as a pair (E-O). If you are free to choose a representation for the two sums, this pair notation would be an alternative to a list with two elements. Your example query yields the desired result:
?- list_sums([5,4,9,8,1,7],L).
L = [12, 22].
And the example from the comments terminates considerably faster:
?- length(L,100),maplist(=(1),L),time(list_sums(L,[A,B])).
% 703 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 3426895 Lips)
L = [1, 1, 1, 1, 1, 1, 1, 1, 1|...],
A = 0,
B = 100.
However, due to the use of is/2 this is only working in one direction. If you'd like to use the predicate in the other direction as well, you could opt to use CLP(FD). In that case include the line
:- use_module(library(clpfd)).
in your source file and replace all occurrences of is/2 in list_sums_/3
by #=/2:
list_sums_([],[E,O],E-O).
list_sums_([X|Xs],S,E0-O0) :-
M #= X mod 2,
if_(M=0,(E1 #= E0+X, O1 #= O0),(E1 #= E0, O1 #= O0+X)),
list_sums_(Xs,S,E1-O1).
Your example query still yields the same result and the example from the comments terminates in an acceptable time:
?- length(L,100),maplist(=(1),L),time(list_sums(L,[A,B])).
% 18,928 inferences, 0.004 CPU in 0.004 seconds (99% CPU, 4888152 Lips)
L = [1, 1, 1, 1, 1, 1, 1, 1, 1|...],
A = 0,
B = 100.
But the predicate works in both directions now. In some cases Prolog can find concrete answers without further ado:
?- list_sums([A,B],[2,1]).
A = 2,
B = 1 ;
A = 1,
B = 2 ;
false.
In other cases you get residual goals as an answer:
?- L=[A,B,C,D,E,F], list_sums(L,[12,22]).
L = [A, B, C, D, E, F],
A+B#=_G3306,
A mod 2#=0,
B mod 2#=0,
_G3306+C#=_G3342,
C mod 2#=0,
_G3342+D#=12,
D mod 2#=0,
E+F#=22,
E mod 2#=_G3402,
F mod 2#=_G3414,
_G3414 in 0..1,
dif(_G3414, 0),
_G3402 in 0..1,
dif(_G3402, 0) ;
...
In these cases you can restrict the elements of the list to some interval and use label/1 to get concrete numbers as solution. For example, you can ask for solutions with six numbers from zero to seven and Prolog will give you all 300 solutions:
?- length(L,6), L ins 0..7, list_sums(L,[12,22]), label(L).
L = [6, 6, 1, 7, 7, 7] ;
L = [6, 6, 3, 5, 7, 7] ;
...
You can use a functionnal way :
one_sum(X, [SE,SO], [SE1, SO1]) :-
( X mod 2 =:= 0 ->
SE1 is SE+X, SO1 = SO
; SE1 = SE, SO1 is SO+X).
sum(L, S) :-
foldl(one_sum, L, [0,0], S).
How can I rotate a 4 x 4 matrix about its center point in Prolog ? I can simply rearrange the elements in case of 4 x 4 matrix but how to do this for a general case like N x N ?
What you want is not quite matrix transposition... but almost!
:- use_module(library(clpfd)).
matrix_rotated(Xss, Zss) :-
transpose(Xss, Yss),
maplist(reverse, Yss, Zss).
Sample query:
?- matrix_rotated([[a1,a2,a3,a4],
[b1,b2,b3,b4],
[c1,c2,c3,c4]], Xss).
Xss = [[c1,b1,a1],
[c2,b2,a2],
[c3,b3,a3],
[c4,b4,a4]].
Someone is wrong on the internet, so duty calls.
We must obey Cunningham's Law, after all.
This answer makes good use of library(clpfd) as found in SWI-Prolog.
:- use_module(library(clpfd)).
rotate_clockwise(Matrix, N, Rotated) :-
N_mod_4 #= N mod 4,
rotate_clockwise_(N_mod_4, Matrix, Rotated).
rotate_clockwise_(0, M, M).
rotate_clockwise_(1, M, R) :-
transpose(M, R0),
maplist(reverse, R0, R).
rotate_clockwise_(2, M, R) :-
reverse(M, R0),
maplist(reverse, R0, R).
rotate_clockwise_(3, M, R) :-
transpose(M, R0),
reverse(R0, R).
You can rotate a rectangular matrix by flipping it twice (try it out with a book or something).
Depending on the two axes along which you flip, you get one of the 3 non-trivial rotations: if we agree that "one rotation" is 90 degrees clockwise, then you can rotate 0, 1, 2, or 3 times. In the code above:
flip along horizontal axis is reverse
flip along vertical axis is maplist(reverse)
flip along the top-left-lower-right axis is transpose
As to why not just define rotating once 90 degrees clockwise and then rotate multiple times: well, it is actually more code!
With the definition above, no matter what valid arguments we give to rotate_clockwise/3, it does the right rotation, doesn't do unnecessary flips, and keeps the caller code short.
?- rotate_clockwise([[a,b,c],[d,e,f]], -1, R). % once counter-clockwise
R = [[c, f], [b, e], [a, d]].
?- rotate_clockwise([[a,b,c],[d,e,f]], 2, R). % 180 degrees
R = [[f, e, d], [c, b, a]].
?- rotate_clockwise([[a,b,c],[d,e,f]], 168, R). % rotate once each hour, for a week
R = [[a, b, c], [d, e, f]].
?- rotate_clockwise([[a,b,c],[d,e,f]], N, R). % enumerate all possibilities
R = [[a, b, c], [d, e, f]],
N mod 4#=0 ;
R = [[d, a], [e, b], [f, c]],
N mod 4#=1 ;
R = [[f, e, d], [c, b, a]],
N mod 4#=2 ;
R = [[c, f], [b, e], [a, d]],
N mod 4#=3.
?- Matrix = [[a],[b]],
rotate_clockwise(Matrix, -1, R),
rotate_clockwise(Matrix, 3, R). % those two mean the same
Matrix = [[a], [b]],
R = [[a, b]].
as noted, transpose/2 isn't the right solution. I've coded something (maybe a bit too much general), that allows to specify the amount of rotation in term of number of cells to shift to right. Shift defaults to 1, but then I noted that to get 90° rotations, the shift is decreasing while passing to inner frames. Passing an anonymous variable to matrix_rotate/3 has the effect of using the current inner frame size. Then, it rotates 90° clockwise.
/** <module> matrix_rotate
*
* answer to http://stackoverflow.com/questions/35594027/rotate-a-matrix-in-prolog
* --------
*
* source file /home/carlo/prolog/matrix_rotate.pl
* created at mer feb 24 16:43:50 2016
*
* #author carlo
* #version 0.9.9
* #copyright carlo
* #license LGPL v2.1
*/
:- module(matrix_rotate,
[matrix_rotate/2
,matrix_rotate/3
,matrix_allocate/4
,matrix_row_col_element/4
,rowcol/3
]).
:- meta_predicate matrix_allocate(3, +,+,-).
matrix_allocate(Pred, NRows, NCols, Mat) :-
bagof(Vs, Row^(
between(1, NRows, Row),
bagof(C, Col^(between(1, NCols, Col), call(Pred, Row, Col, C)), Vs)
), Mat).
empty(_R,_C,_).
rowcol(R, C, (R,C)).
matrix_rotate(Mat, Rot) :-
matrix_rotate(Mat, 1, Rot).
matrix_rotate(Mat, Shift, Rot) :-
matrix_is_square(Mat, Size),
matrix_allocate(empty, Size, Size, Rot),
frames_shift(Mat, Shift, 1, Rot),
( Size mod 2 =:= 1
-> Cen is Size // 2 + 1,
matrix_row_col_element(Mat, Cen, Cen, E),
matrix_row_col_element(Rot, Cen, Cen, E)
; true
).
frames_shift(Mat, Shift, Frame, Rot) :-
length(Mat, Size),
Frame =< Size // 2,
( integer(Shift)
-> ActualShift = Shift
; ActualShift is Size - (Frame - 1)*2 - 1
),
frame(Mat, Frame, L),
shift_right(L, ActualShift, S),
frame(Rot, Frame, S),
F is Frame+1,
!, frames_shift(Mat, Shift, F, Rot).
frames_shift(_Mat, _Shift, _Frame, _Rot).
matrix_is_square(Mat, Size) :-
length(Mat, Size),
forall(member(Row, Mat), length(Row, Size)).
matrix_row_col_element(Mat, Row, Col, El) :-
nth1(Row, Mat, Cells),
nth1(Col, Cells, El).
shift_right(List, Shift, Shifted) :-
length(Post, Shift),
append(Pre, Post, List),
append(Post, Pre, Shifted).
frame(Mat, N, Frame) :-
length(Mat, S),
T is N, B is S-N+1,
L is N, R is S-N+1,
matrix_range_elements(Mat, T,T, L,R-1, Top),
matrix_range_elements(Mat, T,B-1, R,R, Right),
matrix_range_elements(Mat, B,B, R,L+1, Bottom),
matrix_range_elements(Mat, B,T+1, L,L, Left),
append([Top, Right, Bottom, Left], Frame).
matrix_range_elements(Mat, RStart, RStop, CStart, CStop, Elems) :-
bagof(E, matrix_element_between(Mat, RStart, RStop, CStart, CStop, E), Elems).
matrix_element_between(Mat, RStart, RStop, CStart, CStop, Elem) :-
signed_between(RStart, RStop, R),
signed_between(CStart, CStop, C),
matrix_row_col_element(Mat, R, C, Elem).
signed_between(Start, Stop, I) :-
A is Start, B is Stop,
( B < A -> between(B, A, N), I is A+B-N ; between(A, B, I) ).
This snippets highlights some general pattern useful while processing matrices as list of lists. And some of the difficulties, too...
Example usage:
?- matrix_allocate(rowcol,4,4,M),matrix_rotate(M,_,R),maplist(writeln,R).
[(4,1),(3,1),(2,1),(1,1)]
[(4,2),(3,2),(2,2),(1,2)]
[(4,3),(3,3),(2,3),(1,3)]
[(4,4),(3,4),(2,4),(1,4)]
M = [[(1, 1), (1, 2), (1, 3), (1, 4)], [(2, 1), (2, 2), (2, 3), (2, 4)], [(3, 1), (3, 2), (3, 3), (3, 4)], [(4, 1), (4, 2), (4, 3), (4, 4)]],
R = [[(4, 1), (3, 1), (2, 1), (1, 1)], [(4, 2), (3, 2), (2, 2), (1, 2)], [(4, 3), (3, 3), (2, 3), (1, 3)], [(4, 4), (3, 4), (2, 4), (1, 4)]].
?- matrix_allocate(rowcol,3,3,M),matrix_rotate(M,_,R),maplist(writeln,R).
[(3,1),(2,1),(1,1)]
[(3,2),(2,2),(1,2)]
[(3,3),(2,3),(1,3)]
M = [[(1, 1), (1, 2), (1, 3)], [(2, 1), (2, 2), (2, 3)], [(3, 1), (3, 2), (3, 3)]],
R = [[(3, 1), (2, 1), (1, 1)], [(3, 2), (2, 2), (1, 2)], [(3, 3), (2, 3), (1, 3)]].
I am new to Prolog and I want to write poppler(Nums, Plate, Tastiness) that takes a list of exactly 9 numbers as input, and, if possible, returns a permutation of those numbers that forms a delicious poppler plate when Plate is read in row-major format.
A Poppler plate is said to be delicious if the sum of the Popplers in each of the three rows, columns, and two main diagonals is the same. This common sum is called its tastiness.
For example, this is a delicious Poppler plate with tastiness 15:
2 7 6
9 5 1
4 3 8
Here is my try:
size([], 0).
size([Head|T], N) :-
size(T, N1),
N is N1+1.
is_equal([U, V, W], [X, Y, Z], Sum) :-
Sum is U + V + W,
Sum is X + Y + Z.
poppler(Nums, Plate, Tastiness):-
size(Nums, 9),
poppler(Nums, [A, B, C, D, E, F, G, H, I], Tastiness),
member(A, Nums),
member(B, Nums),
member(C, Nums),
member(D, Nums),
member(E, Nums),
member(F, Nums),
member(G, Nums),
member(H, Nums),
member(I, Nums),
is_equal([A, B, C], [D, E, F], Tastiness),
is_equal([A, B, C], [G, H, I], Tastiness),
is_equal([G, H, I], [D, E, F], Tastiness),
is_equal([A, D, G], [B, E, H], Tastiness),
is_equal([A, D, G], [C, F, I], Tastiness),
is_equal([B, E, H], [C, F, I], Tastiness),
is_equal([A, E, I], [C, E, G], Tastiness).
But this doesn't work. How can I fix it?
Here is a fixed version of your code with some comments. Tested in SWI-Prolog.
It works, but it's really slow (will work for minutes for your example). This is because the search space is large, and there is no search space pruning.
Your should really use constraint programming approach for this problem - it prunes search space in a clever way, and that program works instantly.
% should really just use length/2
size([], 0).
size([Head|T],N) :- size(T,N1), N is N1+1.
% could use simpler version of this like "is_equal([X, Y, Z], Sum)"
is_equal([U, V, W], [X, Y, Z], Sum) :- Sum is U + V + W, Sum is X + Y + Z.
poppler(Nums, Plate, Tastiness) :-
size(Nums, 9),
[A, B, C, D, E, F, G, H, I] = Plate,
msort(Nums, Sorted),
member(A, Nums),
member(B, Nums),
member(C, Nums),
member(D, Nums),
member(E, Nums),
member(F, Nums),
member(G, Nums),
member(H, Nums),
member(I, Nums),
% Check if Plate is a permutation of Nums
msort(Plate, Sorted),
is_equal([A, B, C], [D, E, F], Tastiness),
is_equal([A, B, C], [G, H, I], Tastiness),
is_equal([G, H, I], [D, E, F], Tastiness),
is_equal([A, D, G], [B, E, H], Tastiness),
is_equal([A, D, G], [C, F, I], Tastiness),
is_equal([B, E, H], [C, F, I], Tastiness),
is_equal([A, E, I], [C, E, G], Tastiness).
Looks like a perfect problem to solve with constraint logic programming.
Here is my solution in ECLiPSe CLP Prolog (can be translated to other Prolog systems):
:- lib(gfd).
poppler(Nums, Plate, S) :-
[A, B, C, D, E, F, G, H, I] = Plate,
sorted(Nums, Sorted), sorted(Plate, Sorted),
% rows
A + B + C #= S,
D + E + F #= S,
G + H + I #= S,
% colums
A + D + G #= S,
B + E + H #= S,
C + F + I #= S,
% diagonals
A + E + I #= S,
C + E + G #= S,
labeling(Plate).
Test run:
[eclipse]: poppler([1, 2, 3, 4, 5, 6, 7, 8, 9], Plate, 15).
Plate = [2, 7, 6, 9, 5, 1, 4, 3, 8]
I think your main problem is that using member/2 you are generating much more attempts than will be discarded later. You could instead use permutation/2:
poppler0(Nums, Plate, Tastiness):-
Plate = [A, B, C, D, E, F, G, H, I],
permutation(Nums, Plate),
is_equal([A, B, C], [D, E, F], Tastiness),
is_equal([A, B, C], [G, H, I], Tastiness),
is_equal([G, H, I], [D, E, F], Tastiness),
is_equal([A, D, G], [B, E, H], Tastiness),
is_equal([A, D, G], [C, F, I], Tastiness),
is_equal([B, E, H], [C, F, I], Tastiness),
is_equal([A, E, I], [C, E, G], Tastiness).
yields
?- numlist(1,9,L),poppler0(L,X,15).
L = [1, 2, 3, 4, 5, 6, 7, 8, 9],
X = [2, 7, 6, 9, 5, 1, 4, 3, 8] ;
L = [1, 2, 3, 4, 5, 6, 7, 8, 9],
X = [2, 9, 4, 7, 5, 3, 6, 1, 8] ;
...
Instead of member/3, select/3 would get non duplicated:
poppler1(Nums, Plate, Tastiness):-
Plate = [A, B, C, D, E, F, G, H, I],
%permutation(Nums, Plate),
select(A, Nums, Num1),
select(B, Num1, Num2),
select(C, Num2, Num3),
select(D, Num3, Num4),
select(E, Num4, Num5),
select(F, Num5, Num6),
select(G, Num6, Num7),
select(H, Num7, Num8),
select(I, Num8, []),
is_equal([A, B, C], [D, E, F], Tastiness),
is_equal([A, B, C], [G, H, I], Tastiness),
is_equal([G, H, I], [D, E, F], Tastiness),
is_equal([A, D, G], [B, E, H], Tastiness),
is_equal([A, D, G], [C, F, I], Tastiness),
is_equal([B, E, H], [C, F, I], Tastiness),
is_equal([A, E, I], [C, E, G], Tastiness).
Also, since the permutation now is 'sliced', we could 'push' some of the tests early, to make the whole faster:
poppler2(Nums, Plate, Tastiness):-
Plate = [A, B, C, D, E, F, G, H, I],
select(A, Nums, Num1),
select(B, Num1, Num2),
select(C, Num2, Num3),
select(D, Num3, Num4),
select(E, Num4, Num5),
select(F, Num5, Num6),
is_equal([A, B, C], [D, E, F], Tastiness),
select(G, Num6, Num7),
select(H, Num7, Num8),
select(I, Num8, []),
is_equal([A, B, C], [G, H, I], Tastiness),
is_equal([G, H, I], [D, E, F], Tastiness),
is_equal([A, D, G], [B, E, H], Tastiness),
is_equal([A, D, G], [C, F, I], Tastiness),
is_equal([B, E, H], [C, F, I], Tastiness),
is_equal([A, E, I], [C, E, G], Tastiness).
?- numlist(1,9,L),time(poppler0(L,X,15)).
% 642,293 inferences, 0.253 CPU in 0.256 seconds (99% CPU, 2540589 Lips)
L = [1, 2, 3, 4, 5, 6, 7, 8, 9],
X = [2, 7, 6, 9, 5, 1, 4, 3, 8]
.
8 ?- numlist(1,9,L),time(poppler1(L,X,15)).
% 385,446 inferences, 0.217 CPU in 0.217 seconds (100% CPU, 1777885 Lips)
L = [1, 2, 3, 4, 5, 6, 7, 8, 9],
X = [2, 7, 6, 9, 5, 1, 4, 3, 8]
.
9 ?- numlist(1,9,L),time(poppler2(L,X,15)).
% 48,409 inferences, 0.029 CPU in 0.029 seconds (100% CPU, 1643812 Lips)
L = [1, 2, 3, 4, 5, 6, 7, 8, 9],
X = [2, 7, 6, 9, 5, 1, 4, 3, 8]
Another minor problem is that some sum is evaluated more than a time, that's probably due to your choice to code the test with is_equal/3. I would write instead
poppler3(Nums, Plate, Tastiness):-
Plate = [A, B, C, D, E, F, G, H, I],
select(A, Nums, Num1),
select(B, Num1, Num2),
select(C, Num2, Num3),
sumlist([A, B, C], Tastiness),
select(D, Num3, Num4),
select(E, Num4, Num5),
select(F, Num5, Num6),
sumlist([D, E, F], Tastiness),
select(G, Num6, Num7),
sumlist([A, D, G], Tastiness),
sumlist([C, E, G], Tastiness),
select(H, Num7, Num8),
sumlist([B, E, H], Tastiness),
select(I, Num8, []),
sumlist([G, H, I], Tastiness),
sumlist([C, F, I], Tastiness),
sumlist([A, E, I], Tastiness).
that yields
?- numlist(1,9,L),time(poppler3(L,X,15)).
% 14,371 inferences, 0.004 CPU in 0.004 seconds (99% CPU, 3359784 Lips)
L = [1, 2, 3, 4, 5, 6, 7, 8, 9],
X = [2, 7, 6, 9, 5, 1, 4, 3, 8]
.
but again, sumlist/2 is more general than required, and there is further gain to inline the sum:
poppler4(Nums, Plate, Tastiness):-
Plate = [A, B, C, D, E, F, G, H, I],
select(A, Nums, Num1),
select(B, Num1, Num2),
select(C, Num2, Num3),
A+B+C =:= Tastiness,
select(D, Num3, Num4),
select(E, Num4, Num5),
select(F, Num5, Num6),
D+E+F =:= Tastiness,
select(G, Num6, Num7),
A+D+G =:= Tastiness,
C+E+G =:= Tastiness,
select(H, Num7, Num8),
B+E+H =:= Tastiness,
select(I, Num8, []),
G+H+I =:= Tastiness,
C+F+I =:= Tastiness,
A+E+I =:= Tastiness.
yields
?- numlist(1,9,L),time(poppler4(L,X,15)).
% 3,394 inferences, 0.002 CPU in 0.002 seconds (100% CPU, 1827856 Lips)
L = [1, 2, 3, 4, 5, 6, 7, 8, 9],
X = [2, 7, 6, 9, 5, 1, 4, 3, 8]
.
How to create n x n matrix in Prolog and inside the matrix is list of n to 1.
I can create the coding for generate list but do not know how to create a matrix n x n:
make_num_list(N, List) :-
make_list(N, List).
make_list(N, []) :-
N =< 0,
!.
make_list(N, [N|Rest]) :-
N > 0,
N2 is N - 1,
make_list(N2, Rest).
most Prolog out there have between/3, and surely will have findall/3
make_matrix(N, M) :- findall(Ns, (between(1,N,_), make_list(N,Ns)), M).
Reuse your code, and your ideas.
make_num_matrix(N, Matrix) :-
make_matrix(N, N, Matrix).
make_matrix(_, N, []) :-
N =< 0,
!.
make_matrix(M, N, [R|Rs]) :-
make_list(M, R),
N2 is N - 1,
make_matrix(M, N2, Rs).
make_list(N, []) :-
N =< 0,
!.
make_list(N, [N|Rest]) :-
N > 0,
N2 is N - 1,
make_list(N2, Rest).
?- make_num_matrix(4, M).
M = [[4, 3, 2, 1], [4, 3, 2, 1], [4, 3, 2, 1], [4, 3, 2, 1]].