program genstr;
type strarr = array[1..30] of integer;
var i,j,k : integer;
br, start: integer;
B : strarr;
function min (r: integer; s: integer):integer;
begin;
if r >= s then min := s
else min := r;
end;
function noseq (var A: strarr; usedlen:integer;el:integer ): boolean;
var i, j, k, t, q, br, l, flag: integer;
helparr : array [1..10] of integer;
begin
A[usedlen] := el;
q:= usedlen div 3;
for j:= 1 to q do
for i:= 1 to j do
begin
br:= 0;
for l := 1 to j do helparr [l] := 2;
flag := 0;
for k := i to usedlen do
begin
if (k mod q) = 0 then t:= q
else t := k mod q;
if k mod q = 1 then
begin
if flag = q then
begin
br := br+1;
if br= 2 then noseq := false
else br := 0;
end
else flag := 0;
end;
if A[k]= helparr[t] then flag := flag + 1;
helparr [t] := A[k];
end;
if br < 2 then noseq := true;
end;
end;
procedure newel (var A:strarr;var i:integer;start: integer; el:integer);
begin
if noseq (A, i, el) = true then
begin
A[i] := el;
i:= i+1;
if i < start then newel (A, i , start, (random(256)mod 2));
end
else
begin
if noseq(A, i, ((el + 1) mod 2)) = true then
begin
A[i]:= (el + 1) mod 2;
i := i+ 1;
if i < start then newel (A, i , start, (random(256) mod 2));
end
else
begin
i:=i - 1;
newel(A, i , start, (A[i] mod 2));
end
end;
end;
begin
br := 0;
i := 1;
write ('String generation is on');writeln('');
repeat
k:=( random (256) mod 2);
start := i;
newel(B, i, start, k);
br:= br + 1;
until (i > 29) or (br > 1000 );
if br > 1000 then write (' Can not generate str')
else begin
for j := 1 to 30 do write (B[j]);
end;
end. 
