Доказать, что для всякого n существует последовательность нулей и единиц длины 2n с последующим свойством

Program Spis;
Uses crt;
Type Pint=^intr;
     intr=record
       a:string;
       next:Pint;
     end;
     
Type cif=^nol;
     nol=record
       e:string;
       nexte:cif;
     end;
     
     Procedure PoiskCreate(Var sled:cif;  Var Hed:Pint; var  n:integer);  
Var p,d:cif; C:Pint; i:integer; zn:string;
   // Здесь по сути я должен был создавать новый список котрый содержал в себе N отрезки 0 и 1
begin
  New(P);
   c:=Hed;
 
  if sled=nil then
    begin
         p^.e := p^.e + c^.a;
         c:=C^.next;
         p^.e:=p^.e + c^.a;
         //Тут должна быть еще одна строчка которая сохраняла бы адрес 2 ячейки в выборке, нужно для того чтобы в  дальнейшем начинать с него, а ни с первой ячейки
        //Был еще один вариант с прокручиванием списка, то есть первая ячейка становилась на место преведущей, а 2 ячейка на место первой и тд. И выполнялось бы пока не прокрутит весь список 
         for i:= 3 to n do
             begin
                  c:=C^.next;
                  p^.e := p^.e + c^.a;
             end;
 
         p^.nexte:=nil;
         sled:=p;
         writeln(p^.e);
         readln;
    end
    
      else
       begin
            d:=sled;
            
            while d^.nexte<>nil do
                  d:=d^.nexte;
                  
            p^.nexte:=nil;
            d^.e:=zn;
       end;
end;
     
Procedure NtCreat(Var Hed:Pint);  //процедура создания элемента списка
Var C,B:Pint;
   
begin
  New(C);
  Write('Введите элемент ');
  readLn(C^.a);
  if hed=nil then
    begin
      hed:=c;
      hed^.next:=Hed;  //так как список кольцевой,то сюда вставляем адрес "головы"
    end      else
    begin
      b:=hed;
      while b^.next<>hed do
        b:=b^.next;
      c^.next:=Hed;
      b^.next:=c;
    end;
end;
 
Procedure View(Var Hed:Pint);  // процедура просмотра всего списка
Var C:Pint;
begin
  c:=Hed;     //Встали на первый элемент списка
  if c=nil then
  begin
   WriteLn('Список пуст! ');
   readLn;
   exit;
  end;
 repeat
    WriteLn(C^.a);  // читаем элементы списка до тех пор,пока не перейдём на начало
    Write('Далее ');
    readLn;     //Жмём Enter
    c:=C^.next;  //Движение по списку
 until C=hed;
  WriteLn('Конец списка!Опять голова! ');  //с последнего элемента перешли на первый)))
  readLn;
end;
 
Function Show(Var Sp:pint):boolean;
Var i:char;  
begin
  Show:=true;
  Writeln('1- Просмотреть весь список ');
  WriteLn('2- Выход ');
  i:=readkey;
  case i of
    '1':View(sp);
    '2':Show:=false;
  end;
end;
 
Var Spisok:Pint;
  spi, p:cif;
    F:boolean;
     
    i,ck, st, n, nd:integer;
Begin
  ClrScr;
  Spisok:=nil;
  Spi:=nil;
  writeln('Введите n');
  readln(n);
  writeln('Введите C');
  readln(ck);
  nd:=1;
  st := 1;
  
  for i:= 1 to n do 
    nd := nd * 2;
    writeln(nd);
    
  for i:= 1 to n do 
    st := st * ck;
    writeln(st);
    
  For i:=1 to nd do  
    NtCreat(Spisok);
 
  PoiskCreate(spi,spisok,n);
  
  repeat
    f:=show(Spisok);
    clrscr;
  until not F;
end.