2012-02-17 2 views
1

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

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

Существует версия (в Labyrinthian пропорциях) Here

Одна вещь, которую я заметил, когда атакуют проблемы с Пролога, что есть всегда (ну 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. 

ответ

2

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

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

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

редактировать: Вот мои усилия:

% 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). 
+0

Спасибо за ваше время Чака - именно то, что я искал - по-другому взглянуть на проблемы, которые я даже не рассматривается. Отличная работа! – magus

Смежные вопросы