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.