Волшебные квадраты на Прологе?

Question

[gromozeka1980]

Вопрос к проложистам, если тут такие есть.

Я года два назад пробовал програмно искать «волшебные квадраты», вроде этого:



П О Л О З

О С О К А

Л О Т О К

О К О В А

З А К А Т



На Прологе это должно быть, по идее тривиально. Записать факты вида:

word('П','О','Л','О','З'). И сделать запрос:



word(A1,A2,A3,A4,A5),word(A2,B1,B2,B3,B4),word(A3, B2,C1,C2,C3),word(A4,B3,C2,D1,D2),word(A5,B4,C3,D2 ,E1).



Я хотел такие запросы генерировать Питоном для квадратов и прямоугольников различного размера, слова находить Прологом и передавать Питону.

Попробовал на swi запустить запрос для квадрата 5*5 и обломался. Не помню, чем там кончилось, то ли он завис, то ли выдал ошибку памяти, то ли просто я долго ждал и не дождался. В итоге просто на Питоне переписал, получилось не так красиво, конечно, но работало.

То ли я swi не умею готовить, то ли для него эта задачка великовата и стоит взять другую реализацию Пролога (какую?), то ли метод такой не подходит для решения. В общем, буду рад послушать умных людей.



Вот, если что, список пятибуквенных русских существительных — dl.dropboxusercontent.com/u/20473637/n.txt

Comments

[m08pvv]

Похоже, что без предварительной информации и сокращения вариантов, будет долго перебирать. А если ввести больше ограничений, то будет быстрее.

Answer 1

[m08pvv]

Если взять за основу код, приведённый по ссылке.

:- use_module(library(error)).
:- use_module(library(clpfd)).
:- use_module(library(lists)).

solve :-
  load_file('n.txt', Words),
  member([A1, A2,  A3,  A4,  A5], Words),
  member([A2, A6,  A7,  A8,  A9], Words),
  member([A3, A7, A10, A11, A12], Words),
  member([A4, A8, A11, A13, A14], Words),
  member([A5, A9, A12, A14, A15], Words),
  writef("%s\n", [[A1, A2,  A3,  A4,  A5]]),
  writef("%s\n", [[A2, A6,  A7,  A8,  A9]]),
  writef("%s\n", [[A3, A7, A10, A11, A12]]),
  writef("%s\n", [[A4, A8, A11, A13, A14]]),
  writef("%s\n", [[A5, A9, A12, A14, A15]]).

load_file(File, Words) :-
  open(File, read, Stream, []),
  call_cleanup(load_strings(Stream,Words), close(Stream)).

load_strings(Stream, Words) :-
  read_line_to_codes(Stream, T0),
  load_strings(T0, Stream, Words).

load_strings(end_of_file, _Stream, []) :- !.
load_strings([], _Stream, []) :- !.
load_strings(Line, Stream, [Line|Rest]) :-
  read_line_to_codes(Stream, NextLine),
  load_strings(NextLine, Stream, Rest).

Скомпилировать:
swipl -O -c words.pl

И запустить…

абака
бадан
адепт
капер
антре

Находится моментально!

Comments

[m08pvv]

А если вызвать findall([A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14],solve,R).
То будем непрерывно получать новые и новые решения, причём тоже довольно шустро.

[gromozeka1980]

Спасибо!

[m08pvv]

Итоговый вариант: swipl -g true -O -q -t main -o words -c words.pl

words.pl

:- use_module(library(error)).
:- use_module(library(clpfd)).
:- use_module(library(lists)).

main :-
  findall([A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15],solve,R).

solve :-
  load_file('n.txt', Words),
  member([A1, A2,  A3,  A4,  A5], Words),
  member([A2, A6,  A7,  A8,  A9], Words),
  member([A3, A7, A10, A11, A12], Words),
  member([A4, A8, A11, A13, A14], Words),
  member([A5, A9, A12, A14, A15], Words),
  writef("%s\n", [[A1, A2,  A3,  A4,  A5]]),
  writef("%s\n", [[A2, A6,  A7,  A8,  A9]]),
  writef("%s\n", [[A3, A7, A10, A11, A12]]),
  writef("%s\n", [[A4, A8, A11, A13, A14]]),
  writef("%s\n\n", [[A5, A9, A12, A14, A15]]).

load_file(File, Words) :-
  open(File, read, Stream, []),
  call_cleanup(load_strings(Stream,Words), close(Stream)).

load_strings(Stream, Words) :-
  read_line_to_codes(Stream, T0),
  load_strings(T0, Stream, Words).

load_strings(end_of_file, _Stream, []) :- !.
load_strings([], _Stream, []) :- !.
load_strings(Line, Stream, [Line|Rest]) :-
  read_line_to_codes(Stream, NextLine),
  load_strings(NextLine, Stream, Rest).