%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%                                                                    %%
%% http://www.research.att.com/~njas/sequences/polyhexp.txt           %%
%%                                                                    %%
%% A set of Prolog-definitions that illustrate how the first terms    %%
%% of A0xxxxx are produced.                                           %%
%%                                                                    %%
%% Written by Antti Karttunen, 2004, http://www.iki.fi/kartturi/      %%
%%                                                                    %%
%% Last edited September 12, 2004.                                    %%
%%                                                                    %%
%% This works with GNU prolog:                                        %%
%% http://www.gnu.org/software/gprolog/gprolog.html                   %%
%%                                                                    %%
%% Load as:                                                           %%
%% consult('/karttu/prolog/polyhexp.txt').                            %%
%% then "execute" with:                                               %%
%% findall([G|S],signatperm(G,64,S),GMs_with_their_sigperms).         %%
%% or: findall([G|S],signatperm(G,196,S),GMs_with_their_sigperms).    %%
%%                                                                    %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% For rotating list left (or right).

rot([],[]).

rot([X|Xs],Y) :-
  append(Xs,[X],Y).

add(X,Y,Z) :-
  length(LX,X),
  length(LY,Y),
  append(LX,LY,LZ),
  length(LZ,Z),
  !.

equlengths([],[]).

equlengths([_|X],[_|Y]) :-
  equlengths(X,Y).

nzeros([],0) :-
  !.

nzeros([0|X],N) :-
  M is N-1,
  nzeros(X,M),
  !.

%% If we can repeatedly apply these two Post-productions:
%%   A011110B -> A11B
%% and
%%   A01110B  -> A101B
%% until the string of six 1's (111111) results,
%% then the original binary string was also a valid
%% holeless polyhex.

%% Note that we can ignore the productions
%% A00B -> A100001B, A010B -> A10001B, A0110B -> A1001B
%% because every valid non-monic polyhex must contain at least
%% two instances of one of the convex paths 0110, 01110 or 011110
%% somewhere on its edge (e.g. 1111011110 or 111011101110)
%% and although not necessarily in the beginning of the sequence,
%% at least one instance is somewhere as whole, not broken by wrap-over.
%% This is fortunate, because including those two
%% additional productions would introduce other problems.

%% polyhexnhexes(X,N) is true if X can be rewritten to [1,1,1,1,1,1]
%% with N-1 polyhex-rewriting rules.

polyhexnhexes(X,N) :-
  M is N-1,
  nzeros(L,M),
  ithexrewrite(X,[1,1,1,1,1,1],L).

ispolyhex(X,N) :-
  ithexrewrite(X,[1,1,1,1,1,1],L),
  length([0|L],N),
  !.


%% ithexrewrite(X,Y,L) is true if X can be rewritten to Y
%% with (length L) polyhex-rewriting rules:
ithexrewrite([1,1,1,1,1,1],[1,1,1,1,1,1],[]) :-
  !.

ithexrewrite(X,Y,[0|L]) :-
  hexrewrite(X,Z),
  ithexrewrite(Z,Y,L).


%% When checking, i.e. rewriting in X -> '111111' direction
%% iterate as long as the Y is not '111111' and the length
%% keeps decreasing.
%% When generating, i.e. rewriting in X <- '111111' direction
%% iterate as long as the result's length is less than given N.

%% Test:
%% Not only ispolyhex([0,1,1,1,1,0,1,0,1,1,1,1,0,1],N).
%% but also ispolyhex([1,1,1,1,0,1,0,1,1,1,1,0,1,0],N).
%% should return true, with N=3.
%% ispolyhex([1,1,1,1,0,1,0,1,1,1,1,0,1,0],N). --> N = 3
%% ispolyhex([0,1,1,0,1,1,1,1,0,0,1,1,1,1],N). --> N = 3
%% ispolyhex([1,1,1,1,0,1,0,1,0,1,1,1,1,0,1,0,1,0],N). --> N = 4
%% ispolyhex([1,1,1,1,0,1,0,1,0,1,0,1,1,1,1,0,1,0,1,0,1,0],N). --> N = 5
%% ispolyhex([1,1,1,1,0,1,0,1,0,1,0,1,0,1,1,1,1,0,1,0,1,0,1,0,1,0],N). --> N = 6
%% ispolyhex([1,1,0,1,1,0,1,1,1,0,1,1,0,1],N). --> N = 4
%% This works ONLY if the third rewrite-rule 0110 -> 1001 is present:
%% ispolyhex([1,1,0,1,1,0,1,1,0,1,1,0,1,1,0,1,1,0],N). --> N = 7

%% One hex is already lopped off:
%% ispolyhex([1,1,0,1,1,0,1,1,1,0,0,1,1,1,0,1,1,0],N). --> N = 6

%% This should work:
%% ispolyhex([1,1,1,1,0,1,1,0,1,1,0,1,1,0,1,1,1,1,0,0,0,0],N). --> N = 5

%% This should not, in no circumstances:
%% ispolyhex([1,1,1,1,0,1,1,1,0,0,1,1,1,0,1,1,1,1,0,0,0,0],N).



%% The rewrite-rules follow.
%% hexrewrite(X,Y). will match
%% if X can be rewritten to Y.
%% Fails if no rewriting is possible
%% at any position.

%% 011110B -> 11B (perimeter contracted by four edges)
hexrewrite([0,1,1,1,1,0|X],[1,1|X]).

%% 01110B  -> 101B (perimeter contracted by two edges)
hexrewrite([0,1,1,1,0|X],[1,0,1|X]).

%% 0110B  -> 1001B (perimeter stays the same, one hex lopped off)
hexrewrite([0,1,1,0|X],[1,0,0,1|X]).

%% Search a position where to apply one of the three rules given above.
%% This fails if no such position is found.
hexrewrite([A|X],[A|Y]) :-
  hexrewrite(X,Y).