I'm having trouble making this predicate work. The idea is to use diabolic([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P])
to obtain all the possible magic squares in that list.
At first I thought about using permutation/2
but it's hella slow for a list of 16 numbers.
Then I found an example here which uses an external library (clpfd) and has awesome performance, but I'm trying to solve it without any external library... so I tried something like this:
sum([X,Y,Z,W]) :-
A = [1..16],
member(X,A),
member(Y,A),
member(Z,A),
member(W,A),
X \== Y,
X \== Z,
X \== W,
Y \== Z,
Y \== W,
Z \== W,
34 is (X+Y+Z+W).
What I'm trying to do there is getting all the possible lists of different numbers which sum is 34 so I can then check which combination makes a magic square (in hopes of making it faster that using normal permutation.
Still, I'm getting an error about some Operator Expected in member(X,[1..16]),
so maybe i'm doing something wrong. I'm pretty new to Prolog so I was hoping to get some help from you guys.
Thanks in advance.
You are on the right track: enforce as soon as possible a constraint, to prune the search space.
The problem is how 'to split' the permutation process, to be able to prune results ASAP.
A simple minded way:
diabolic([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P]) :-
N0=[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16],
R1=[A,B,C,D],select_list(N0,R1,N1),sum_list(R1,34),
R2=[E,F,G,H],select_list(N1,R2,N2),sum_list(R2,34),
R3=[I,J,K,L],select_list(N2,R3,N3),sum_list(R3,34),
R4=[M,N,O,P],select_list(N3,R4,[]),sum_list(R4,34),
sum_list([A,E,I,M],34),
sum_list([B,F,J,N],34),
sum_list([C,G,K,O],34),
sum_list([D,H,L,P],34),
sum_list([A,F,K,P],34),
sum_list([M,J,G,D],34).
select_list(X,[],X).
select_list(X,[H|T],Z) :- select(H,X,Y), select_list(Y,T,Z).
this is still much slower that CLP(FD), but could be a starting point...
edit simple code improvements.
The original performance:
?- forall(time(diabolic(L)),writeln(L)).
% 74,769,227 inferences, 23.739 CPU in 23.754 seconds (100% CPU, 3149688 Lips)
[1,2,15,16,12,14,3,5,13,7,10,4,8,11,6,9]
% 7,556,909 inferences, 2.396 CPU in 2.448 seconds (98% CPU, 3154252 Lips)
[1,2,15,16,13,14,3,4,12,7,10,5,8,11,6,9]
% 90,103,270 inferences, 28.475 CPU in 28.503 seconds (100% CPU, 3164265 Lips)
[1,2,16,15,13,14,4,3,12,7,9,6,8,11,5,10]
Action (h for help) ? aabort
Inlining select_list/3
select_(N0,[A,B,C,D],N1) :-
select(A,N0,T0),
select(B,T0,T1),
select(C,T1,T2),
select(D,T2,N1).
diabol_1([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P]) :-
N0=[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16],
R1=[A,B,C,D],select_(N0,R1,N1),sum_list(R1,34),
R2=[E,F,G,H],select_(N1,R2,N2),sum_list(R2,34),
R3=[I,J,K,L],select_(N2,R3,N3),sum_list(R3,34),
R4=[M,N,O,P],select_(N3,R4,[]),sum_list(R4,34),
sum_list([A,E,I,M],34),
sum_list([B,F,J,N],34),
sum_list([C,G,K,O],34),
sum_list([D,H,L,P],34),
sum_list([A,F,K,P],34),
sum_list([M,J,G,D],34).
we get a small improvement:
?- forall(time(diabol_1(L)),writeln(L)).
% 65,282,719 inferences, 21.137 CPU in 21.195 seconds (100% CPU, 3088524 Lips)
[1,2,15,16,12,14,3,5,13,7,10,4,8,11,6,9]
% 6,607,508 inferences, 2.074 CPU in 2.075 seconds (100% CPU, 3186362 Lips)
[1,2,15,16,13,14,3,4,12,7,10,5,8,11,6,9]
% 78,691,563 inferences, 24.914 CPU in 24.928 seconds (100% CPU, 3158505 Lips)
[1,2,16,15,13,14,4,3,12,7,9,6,8,11,5,10]
Action (h for help) ? aabort
inlining sum_list/2 we see a further small gain:
sum_([A,B,C,D]) :- A+B+C+D =:= 34.
diabol_2([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P]) :-
N0=[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16],
R1=[A,B,C,D],select_(N0,R1,N1),sum_(R1),
R2=[E,F,G,H],select_(N1,R2,N2),sum_(R2),
R3=[I,J,K,L],select_(N2,R3,N3),sum_(R3),
R4=[M,N,O,P],select_(N3,R4,[]),sum_(R4),
sum_([A,E,I,M]),
sum_([B,F,J,N]),
sum_([C,G,K,O]),
sum_([D,H,L,P]),
sum_([A,F,K,P]),
sum_([M,J,G,D]).
?- forall(time(diabol_2(L)),writeln(L)).
% 20,419,167 inferences, 10.425 CPU in 10.431 seconds (100% CPU, 1958699 Lips)
[1,2,15,16,12,14,3,5,13,7,10,4,8,11,6,9]
% 2,058,108 inferences, 1.046 CPU in 1.047 seconds (100% CPU, 1966993 Lips)
[1,2,15,16,13,14,3,4,12,7,10,5,8,11,6,9]
% 24,592,123 inferences, 12.462 CPU in 12.481 seconds (100% CPU, 1973394 Lips)
[1,2,16,15,13,14,4,3,12,7,9,6,8,11,5,10]
Action (h for help) ? aabort