Какая самая прологичная реализация для игры Конвея в Life?

Question

Я выполнил версию этим вечером (как показано ниже), но мне кажется, что я перенес ее с другого процедурного языка и не воспользовался многими «чистыми» функциями Пролога.

Просто запустите его и каждый раз нажимайте Enter для следующего поколения.

Существует версия (в лабиринтных пропорциях) Здесь

Одна вещь, которую я заметил, когда атаковал проблемы с Прологом, это то, что всегда (в 99% случаев) более аккуратная реализация, и на этот раз кажется, что так и есть.

Можно ли придумать какие-нибудь лучшие реализации? Я не доволен своим. Это работает, и не ужасно неэффективно (?), Но все же ...

Похоже, я мог бы лучше использовать объединение, т.е. вместо того, чтобы рассматривать соседей как координаты X, Y относительно любой данной ячейки, которую я проверяю по отдельности, я мог бы каким-то образом заставить Пролог сделать для меня часть тяжелой работы.

% Conway Game of Life (Stack Overflow, 'magus' implementation)

% The life grid, 15x15
grid([
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,1,0,1,0,1,0,0,0,0,0],
      [0,0,0,0,0,1,0,0,0,1,0,0,0,0,0],
      [0,0,0,0,0,1,0,0,0,1,0,0,0,0,0],
      [0,0,0,0,0,1,0,0,0,1,0,0,0,0,0],
      [0,0,0,0,0,1,0,1,0,1,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
     ]
   ).

% Infinite generates sep with keystroke
% -------------------------------------
life(Grid) :-
    dumpgen(Grid),
    onegen(Grid, 0, NewGrid),
    get_single_char(_),
    life(NewGrid).


% Dumps a generation out
% ----------------------
dumpgen([]) :- nl.
dumpgen([H|T]) :-
    write(H), nl,
    dumpgen(T).

% Does one generation
% --------------------------------
onegen(_, 15, []).

onegen(Grid, Row, [NewRow|NewGrid]) :-
    xformrow(Grid, Row, 0, NewRow),
    NRow is Row + 1,
    onegen(Grid, NRow, NewGrid).

% Transforms one row
% --------------------------------
xformrow(_, _, 15, []).
xformrow(Grid, Row, Col, [NewState|NewList]) :-
    xformstate(Grid, Row, Col, NewState),
    NewCol is Col + 1,
    xformrow(Grid, Row, NewCol, NewList).


% Request new state of any cell
% --------------------------------
xformstate(Grid, Row, Col, NS) :-
    cellstate(Grid, Row, Col, CS),
    nextstate(Grid, Row, Col, CS, NS).

% Calculate next state of any cell
% --------------------------------

% Cell is currently dead
nextstate(Grid, Row, Col, 0, NS) :-
    neightotal(Grid, Row, Col, Total),
    (Total =:= 3 -> NS = 1 ; NS = 0).

% Cell is currently alive
nextstate(Grid, Row, Col, 1, NS) :-
    neightotal(Grid, Row, Col, Total),
    ((Total =:= 2; Total =:=3)
    -> NS = 1; NS = 0).

% State of all surrounding neighbours
%-------------------------------------
neightotal(Grid, Row, Col, TotalSum) :-

    % Immediately neighbours X, Y
    XM1 is Col - 1,
    XP1 is Col + 1,
    YM1 is Row - 1,
    YP1 is Row + 1,

    % State at all those compass points
    cellstate(Grid, YM1, Col, N),
    cellstate(Grid, YM1, XP1, NE),
    cellstate(Grid, Row, XP1, E),
    cellstate(Grid, YP1, XP1, SE),
    cellstate(Grid, YP1, Col, S),
    cellstate(Grid, YP1, XM1, SW),
    cellstate(Grid, Row, XM1, W),
    cellstate(Grid, YM1, XM1, NW),

    % Add up the liveness
    TotalSum is N + NE + E + SE + S + SW + W + NW.


% State at any given row/col - 0 or 1
% -----------------------------------
% Valid range, return it's state
cellstate(Grid, Row, Col, State) :-
    between(0, 14, Row),
    between(0, 14, Col),
    nth0(Row, Grid, RL),
    nth0(Col, RL, State).

% Outside range is dead
cellstate(_, _, _, 0).

Исполнение:

[debug]  ?- grid(X), life(X).
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,1,0,1,0,1,0,0,0,0,0]
[0,0,0,0,0,1,0,0,0,1,0,0,0,0,0]
[0,0,0,0,0,1,0,0,0,1,0,0,0,0,0]
[0,0,0,0,0,1,0,0,0,1,0,0,0,0,0]
[0,0,0,0,0,1,0,1,0,1,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]

[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,1,0,1,0,0,0,0,0,0]
[0,0,0,0,1,1,0,0,0,1,1,0,0,0,0]
[0,0,0,0,1,1,1,0,1,1,1,0,0,0,0]
[0,0,0,0,1,1,0,0,0,1,1,0,0,0,0]
[0,0,0,0,0,0,1,0,1,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]

[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,1,0,0,0,1,0,0,0,0,0]
[0,0,0,0,1,0,0,0,0,0,1,0,0,0,0]
[0,0,0,1,0,0,1,0,1,0,0,1,0,0,0]
[0,0,0,0,1,0,0,0,0,0,1,0,0,0,0]
[0,0,0,0,0,1,0,0,0,1,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]

etc.

Answer 1

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

Но предварительно мы могли бы использовать целочисленные значения и операторы битового поля неограниченной точности, которые предлагает SWI-Prolog: тогда строка может быть целым числом, и тестирование состояния ячейки может быть выполнено «сразу», сдвигая 3 строки вместе, маскировка младших битов: нам нужно рассмотреть только 9 битов, то есть 512 значений, которые можно предварительно вычислить. Конечно, проверка границ может усложнить алгоритм: тогда может быть полезно некоторое «внеполосное» заполнение.

Это должно быть легко сделать.

edit: Вот мои усилия:

% Conway Game of Life (Stack Overflow, 'chac' implementation)
%

:- module(lifec, [play/0]).

play :-
    grid(G),
    lifec(G).

% The life grid, 15x15
grid([
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,1,0,1,0,1,0,0,0,0,0],
      [0,0,0,0,0,1,0,0,0,1,0,0,0,0,0],
      [0,0,0,0,0,1,0,0,0,1,0,0,0,0,0],
      [0,0,0,0,0,1,0,0,0,1,0,0,0,0,0],
      [0,0,0,0,0,1,0,1,0,1,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
     ]
   ).

% Infinite generates sep with keystroke
% -------------------------------------
lifec(Grid) :-
    make_ints(Grid, Ints, Size),
    lifei(Ints, Size).

lifei(Ints, Size) :-
    dumpgen(Ints, Size),
    onegen(Ints, Size, NewInts),
    get_single_char(_),
    !, lifei(NewInts, Size).

dumpgen(Ints, Size) :-
    forall(member(I, Ints),
           ( for_next(1, Size, _, show_bit(I)), nl) ).

onegen(Matrix, Size, NewMatrix) :-
    findall(NewBits,
        (three_rows(Matrix, Size, Rows),
         rowstate(Rows, 0, Size, 0, NewBits)), NewMatrix).

three_rows(Matrix, Size, Rows) :-
    nth1(I, Matrix, Row),
    ( I > 1 -> U is I - 1, nth1(U, Matrix, Up) ; Up = 0 ),
    ( I < Size -> D is I + 1, nth1(D, Matrix, Down) ; Down = 0 ),
    % padding: add 0 bit to rightmost position
    maplist(lshift, [Up, Row, Down], Rows).

:- dynamic evopatt/2.

rowstate([_, _, _], Size, Size, NewBits, NewBits) :- !.
rowstate([U, R, D], I, Size, Accum, Result) :-
    Key is (U /\ 7) \/ ((R /\ 7) << 3) \/ ((D /\ 7) << 6),
    evopatt(Key, Bit),
    Accum1 is Accum \/ (Bit << I),
    maplist(rshift, [U,R,D], P),
    J is I + 1,
    rowstate(P, J, Size, Accum1, Result).

%%  initialization
%
make_ints(Grid, Ints, Size) :-
    length(Grid, Size),
    maplist(set_bits(0, 0), Grid, Ints),
    % precompute evolution patterns
    retractall(evopatt(_, _)),
    for_next(0, 511, _, add_evopatt).

add_evopatt(N) :-
    maplist(take_bit(N), [0,1,2], U),
    maplist(take_bit(N), [3,4,5], V),
    maplist(take_bit(N), [6,7,8], Z),
    rule(U, V, Z, Bit),
    assert(evopatt(N, Bit)).

% rules from Rosetta Code
%
rule([A,B,C],[D,0,F],[G,H,I],1) :- A+B+C+D+F+G+H+I =:= 3.
rule([_,_,_],[_,0,_],[_,_,_],0).
rule([A,B,C],[D,1,F],[G,H,I],0) :- A+B+C+D+F+G+H+I < 2.
rule([A,B,C],[D,1,F],[G,H,I],1) :- A+B+C+D+F+G+H+I =:= 2.
rule([A,B,C],[D,1,F],[G,H,I],1) :- A+B+C+D+F+G+H+I =:= 3.
rule([A,B,C],[D,1,F],[G,H,I],0) :- A+B+C+D+F+G+H+I > 3.

%%  utilities
%
:- meta_predicate for_next(+,+,-,1).

for_next(From, To, N, Pred) :-
    forall(between(From, To, N), call(Pred, N)).

lshift(X, Y) :- Y is X << 1.
rshift(X, Y) :- Y is X >> 1.

show_bit(I, P) :-
    take_bit(I, P - 1, 1) -> put(0'*) ; put(0' ).

take_bit(N, Pos, Bit) :-
    Bit is (N >> Pos) /\ 1.

set_bits(_Index, Accum, [], Accum).
set_bits(Index, Accum, [ZeroOne|Rest], Number) :-
    Accum1 is Accum \/ (ZeroOne << Index),
    Index1 is Index + 1,
    set_bits(Index1, Accum1, Rest, Number).