Пролог Я должен сделать программу, которая вычисляет перестановку магической матрицы

Question

Мне нужно сделать программу, которая вычисляет магическую матрицу, я сделал свой код, и он работает, но моя перестановка очень медленная. мне нужен тот, который быстрее кто-то может помочь мне, пожалуйста

Это код:

diabolico([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P]) :- 
    permutar([1,14,3,16,5,12,13,15,9,10,11,6,7,2,8,4],[A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P]), 
    A+B+C+D=:=34, E+F+G+H=:=34, I+J+K+L=:=34, M+N+O+P=:=34, 
    A+E+I+M=:=34, B+F+J+N=:=34, C+G+K+O=:=34, D+H+L+P=:=34, 
    M+B+G+L=:=34, I+N+C+H=:=34, E+J+O+D=:=34, A+F+K+P=:=34, 
    P+C+F+I=:=34, L+O+B+E=:=34, H+K+N+A=:=34, D+G+J+M=:=34. 

permutar([],[]). 
permutar([X|Y], Z):- 
    permutar(Y,L), 
    insertar(X,L,Z). 

insertar(E,L,[E|L]). 
insertar(E, [X|Y], [X|Z]):- 
    insertar(E, Y, Z). 

Answer 1

Зависимость логического программирования это хорошо для таких проблем, резко сократив пространство поиска.

Программа в ECLiPSe (может быть легко переведены на работу с другими современными системами Пролога):

:- lib(ic). 

diabolico([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P]) :- 
    Vars = [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P], 
    Vars :: 1..16, 
    alldifferent(Vars), 
    A+B+C+D #= 34, E+F+G+H #= 34, I+J+K+L #= 34, M+N+O+P #= 34, 
    A+E+I+M #= 34, B+F+J+N #= 34, C+G+K+O #= 34, D+H+L+P #= 34, 
    M+B+G+L #= 34, I+N+C+H #= 34, E+J+O+D #= 34, A+F+K+P #= 34, 
    P+C+F+I #= 34, L+O+B+E #= 34, H+K+N+A #= 34, D+G+J+M #= 34, 
    labeling(Vars). 

работ мгновенно:

[eclipse]: diabolico([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P]). 
A = 1 
B = 8 
C = 10 
D = 15 
E = 12 
F = 13 
G = 3 
H = 6 
I = 7 
J = 2 
K = 16 
L = 9 
M = 14 
N = 11 
O = 5 
P = 4 
Yes (0.02s cpu, solution 1, maybe more) 

Answer 2

Вы можете попробовать использовать перестановку/2, может быть, это быстрее, чем (я не уверен, должен сравните его). В любом случае, перестановки часто требуют другого подхода, например CLP (FD). Я скопировал свой код, и изменить его:

:- use_module(library(clpfd)). 

diabolico([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P]) :- 
Vs = [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P], 
Vs ins 1..16, 
all_different(Vs), 
A+B+C+D#=34, 
E+F+G+H#=34, 
I+J+K+L#=34, 
M+N+O+P#=34, 
A+E+I+M#=34, 
B+F+J+N#=34, 
C+G+K+O#=34, 
D+H+L+P#=34, 
M+B+G+L#=34, 
I+N+C+H#=34, 
E+J+O+D#=34, 
A+F+K+P#=34, 
P+C+F+I#=34, 
L+O+B+E#=34, 
H+K+N+A#=34, 
D+G+J+M#=34, 
label(Vs). 

writerows([]). 
writerows([A,B,C,D|Rs]) :- 
format('~|~t~d~3+~|~t~d~3+~|~t~d~3+~|~t~d~3+~n', [A,B,C,D]), 
writerows(Rs). 

вот пример из:

?- diabolico(X), writerows(X). 
    1 8 10 15 
12 13 3 6 
    7 2 16 9 
14 11 5 4 
X = [1, 8, 10, 15, 12, 13, 3, 6, 7|...] ; 
    1 8 10 15 
14 11 5 4 
    7 2 16 9 
12 13 3 6 
X = [1, 8, 10, 15, 14, 11, 5, 4, 7|...] ; 
    1 8 11 14 
12 13 2 7 
    6 3 16 9 
15 10 5 4 
X = [1, 8, 11, 14, 12, 13, 2, 7, 6|...] 
... 

Мои комплименты вашей permutar 2 реализации /: это гораздо лучше, чем перестановки/2:

?- X=[1,2,3,4,5,6,7,8], time(aggregate(count,X^Y^permutation(X,Y),C)). 
% 328,837 inferences, 0.171 CPU in 0.172 seconds (99% CPU, 1927406 Lips) 
X = [1, 2, 3, 4, 5, 6, 7, 8], 
C = 40320. 

?- X=[1,2,3,4,5,6,7,8], time(aggregate(count,X^Y^permutar(X,Y),C)). 
% 86,597 inferences, 0.079 CPU in 0.081 seconds (99% CPU, 1091190 Lips) 
X = [1, 2, 3, 4, 5, 6, 7, 8], 
C = 40320. 

Увы, тогда мое первоначальное предложение совершенно бесполезно ...

Answer 3

takeout(H,[H|R],R). 
takeout(H,[F|S],[F|R]) :- takeout(H,S,R). 
perm([],[]). 
perm([H|T],S) :- perm(T,R), takeout(H,S,R). 
line([X,Y,Z], S) :- S is X+Y+Z. 
magic([A,B,C, D,E,F, G,H,I]) :- line([A,B,C],S), line([D,E,F],S), line([G,H,I],S), line([A,D,G],S), line([B,E,H],S), line([C,F,I],S). 
solve(S) :- perm([1,2,3,4,5,6,7,8,9],S), magic(S). 

Может решить квадрат 9 * 9 с в следующем примере:

?- solve([1,B,C,D,E,2,G,3,J]). 

Покажет:

B = 8, 
C = 6, 
D = 9, 
E = 4, 
G = 5, 
J = 7 ; 
B = 5, 
C = 9, 
D = 6, 
E = 7, 
G = 8, 
J = 4 ; 
false.