4%

stree(Graph,Tree):-member(Edge,Graph),
	spread([Edge],Tree,Graph).
spread(Tree1,Tree,Graph):-addedge(Tree1,Tree2,Graph),spread(Tree2,Tree,Graph).
spread(Tree,Tree,Graph):-not(addedge(Tree,_,Graph)).
addedge(Tree,[A-B|Tree],Graph):-
	adjacent(A,B,Graph),node(A,Tree),not(node(B,Tree)).
	adjacent(Node1,Node2,Graph):-member(Node1-Node2,Graph);
	member(Node2-Node1,Graph).
node(Node,Graph):-adjacent(Node,_,Graph).


5%


path(From, To) :-
	traverse(From),
	edge([To|ReversedPath], Dist)->
	  reverse([To|ReversedPath], Path),
	  Distance is Dist,
	  writef('Path = %w and the distance is %w = %w\n',
	       [Path, Dist, Distance]);
	writef('There is no path that connects %w with %w\n', [From, To]).


traverse(From) :-
	retractall(edge(_,_)),
	traverse(From,[],0).

traverse(From, Path, Dist) :-
	path(From, T, D),
	not(memberchk(T, Path)),
	shorterPath([T,From|Path], Dist+D),
	traverse(T,[From|Path],Dist+D).

traverse(_).

path(From,To,Dist) :- neighbour(From,To,Dist).

shorterPath([H|Path], Dist) :-
	edge([H|_], D), !, Dist < D,
	retract(edge([H|_],_)),
	assert(edge([H|Path], Dist)).

shorterPath(Path, Dist) :-
	assert(edge(Path,Dist)).


checkCell((X1,Y1),(X2,Y2)) :- checkCell1(X1), checkCell1(Y1), checkCell1(X2), checkCell1(Y2).
checkCell1(X) :-     1 =< X, X =< 8 .

neighbour((X1,Y1),(X2,Y2), 1) :- X2 is X1+2, Y2 is Y1+1, checkCell((X1,Y1),(X2,Y2)).

neighbour((X1,Y1),(X2,Y2), 1) :- X2 is X1+1, Y2 is Y1+2, checkCell((X1,Y1),(X2,Y2)).

neighbour((X1,Y1),(X2,Y2), 1) :- X2 is X1+2, Y2 is Y1-1, checkCell((X1,Y1),(X2,Y2)).

neighbour((X1,Y1),(X2,Y2), 1) :- X2 is X1+1, Y2 is Y1-2, checkCell((X1,Y1),(X2,Y2)).

neighbour((X1,Y1),(X2,Y2), 1) :- X2 is X1-2, Y2 is Y1+1, checkCell((X1,Y1),(X2,Y2)).

neighbour((X1,Y1),(X2,Y2), 1) :- X2 is X1-1, Y2 is Y1+2, checkCell((X1,Y1),(X2,Y2)).

neighbour((X1,Y1),(X2,Y2), 1) :- X2 is X1-2, Y2 is Y1-1, checkCell((X1,Y1),(X2,Y2)).

neighbour((X1,Y1),(X2,Y2), 1) :- X2 is X1-1, Y2 is Y1-2, checkCell((X1,Y1),(X2,Y2)).

%6

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

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


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,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,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
      [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
     ]
   ).

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


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


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.


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