prolog - sencillos - Prólogo Tengo que hacer un programa que calcula la matriz mágica permutada
programacion en prolog (3)
Tengo que hacer un programa que calcule la matriz mágica, hice mi código y funciona, pero mi permute es muy lento. Necesito uno que sea más rápido, alguien me puede ayudar.
Este es el código:
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).
La programación de lógica de restricción funciona bien para este tipo de problemas al podar dramáticamente el espacio de búsqueda.
Programa en ECLiPSe (se puede traducir fácilmente para trabajar con otros sistemas modernos de Prolog):
:- 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).
Funciona al instante:
[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)
Podría tratar de usar permutación / 2, tal vez es más rápido que su (no estoy seguro, debería compararlo). De todos modos, las permutaciones a menudo requieren un enfoque diferente, por ejemplo CLP (FD). Copié tu código y lo modifiqué:
:- 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).
aquí hay una muestra:
?- 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|...]
...
Mis felicitaciones por su implementación de permutar / 2: es mucho mejor que la permutación / 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.
Por desgracia, mi sugerencia inicial es totalmente inútil ...
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).
Puede resolver un cuadrado de 9 * 9 con la siguiente llamada de ejemplo:
?- solve([1,B,C,D,E,2,G,3,J]).
Mostrará:
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.