Question

I banged out a version this evening (as below), but it feels like I ported it from another procedural language, and didn’t take advantage of many ‘pure’ Prolog features.

Just run it and press Enter each time around for the next generation.

There is a version (of labyrinthian proportions) Here

One thing I have noticed when attacking problems with Prolog is that there is always (well 99% of the time) a neater implementation, and it feels like that’s the case this time around.

Any better implementations you can think of ? I’m not happy with mine. It works, and is not horribly inefficient (?), but still…

Seems like I could make better use of unification ie. instead of treating the neighbours as X,Y co-ordinates relative to any given cell that I check individually, I could have somehow got Prolog to do some of the heavy lifting for me.

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

Execution:

[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

I think that the simplicity of the logic claims for simplest data structures, and that ends up similar to other languages.

But tentatively, we could use the unlimited precision integers and bitfield operators that SWI-Prolog offers: then a row can be an integer, and testing the state of a cell could be done ‘at once’ shifting 3 rows together, and masking the lower bits: we have just 9 bits to consider, i.e. 512 values, that can be precomputed. Of course boundaries check could complicate the algorithm: then some ‘out of band’ padding can be helpful.

This should be easy to do.

edit: Here my effort:

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