Пролог - решение Латинской площади
Я пытаюсь написать программу на Прологе, чтобы найти латинский квадрат размером N.
У меня есть это прямо сейчас:
delete(X, [X|T], T).
delete(X, [H|T], [H|S]) :-
delete(X, T, S).
permutation([], []).
permutation([H|T], R) :-
permutation(T, X),
delete(H, R, X).
latinSqaure([_]).
latinSquare([A,B|T], N) :-
permutation(A,B),
isSafe(A,B),
latinSquare([B|T]).
isSafe([], []).
isSafe([H1|T1], [H2|T2]) :-
H1 =\= H2,
isSafe(T1, T2).
3 ответа
Используя библиотеку SWI-Prolog:
:- module(latin_square, [latin_square/2]).
:- use_module(library(clpfd), [transpose/2]).
latin_square(N, S) :-
numlist(1, N, Row),
length(Rows, N),
maplist(copy_term(Row), Rows),
maplist(permutation, Rows, S),
transpose(S, T),
maplist(valid, T).
valid([X|T]) :-
memberchk(X, T), !, fail.
valid([_|T]) :- valid(T).
valid([_]).
тестовое задание:
?- aggregate(count,S^latin_square(4,S),C).
C = 576.
отредактируйте свой код, исправив его, удалив опечатки, это верификатор, а не генератор, но (как отметил ssBarBee в удаленном комментарии) он имеет недостатки из-за отсутствия теста в несмежных строках. Вот исправленный код
delete(X, [X|T], T).
delete(X, [H|T], [H|S]) :-
delete(X, T, S).
permutation([], []).
permutation([H|T], R):-
permutation(T, X),
delete(H, R, X).
latinSquare([_]).
latinSquare([A,B|T]) :-
permutation(A,B),
isSafe(A,B),
latinSquare([B|T]).
isSafe([], []).
isSafe([H1|T1], [H2|T2]) :-
H1 =\= H2,
isSafe(T1, T2).
и какой-то тест
?- latinSquare([[1,2,3],[2,3,1],[3,2,1]]).
false.
?- latinSquare([[1,2,3],[2,3,1],[3,1,2]]).
true .
?- latinSquare([[1,2,3],[2,3,1],[1,2,3]]).
true .
обратите внимание на последний тест, это неправильно, должен дать false
вместо.
У меня есть лучшее решение, код @CapelliC занимает очень много времени для квадратов с длиной N больше 5.
:- use_module(library(clpfd)).
make_square(0,_,[]) :- !.
make_square(I,N,[Row|Rest]) :-
length(Row,N),
I1 is I - 1,
make_square(I1,N,Rest).
all_different_in_row([]) :- !.
all_different_in_row([Row|Rest]) :-
all_different(Row),
all_different_in_row(Rest).
all_different_in_column(Square) :-
transpose(Square,TSquare),
all_different_in_row(TSquare).
all_different_in_column1([[]|_]) :- !.
all_different_in_column1(Square) :-
maplist(column,Square,Column,Rest),
all_different(Column),
all_different_in_column1(Rest).
latin_square(N,Square) :-
make_square(N,N,Square),
append(Square,AllVars),
AllVars ins 1..N,
all_different_in_row(Square),
all_different_in_column(Square),
labeling([ff],AllVars).
Как и @CapelliC, я рекомендую использовать для этого ограничения CLP(FD), которые доступны во всех серьезных системах Prolog.
Фактически, рассмотрите возможность использования ограничений более широко, чтобы извлечь выгоду из распространения ограничений.
Например:
:- use_module(library(clpfd)).
latin_square(N, Rows, Vs) :-
length(Rows, N),
maplist(same_length(Rows), Rows),
maplist(all_distinct, Rows),
transpose(Rows, Cols),
maplist(all_distinct, Cols),
append(Rows, Vs),
Vs ins 1..N.
Пример, подсчитывающий все решения для N = 4
:
? - findall (., (latin_square (4, _, Vs), маркировка ([ff],Vs)), Ls), длина (Ls, L).L = 576, Ls = [...].
Версия CLP(FD) намного быстрее, чем другая версия.
Обратите внимание, что эффективная практика состоит в том, чтобы отделить основное отношение от фактического поиска с помощью labeling/2
, Это позволяет быстро увидеть, что отношение ядра заканчивается и для большего N
:
? - latin_square (20, _, _), false.ложный.
Таким образом, мы непосредственно видим, что это заканчивается, следовательно, это плюс любой последующий поиск с labeling/2
гарантированно найдет все решения.