Число 0,10100100010000100000....

program p1;
uses crt;
var  t:text;
     n:longint;
     i:longint;
begin
clrscr;
write('n=');
readln(n);
 
i:=1;
while i<n do begin
          dec(n,i);
          inc(i);
          end;
 
assign(f,'first.sol');
rewrite(f);
writeln (Otvet v faile "first.sol":');
if n=i
then begin writeln(f,1); writeln (1);
     end
else begin writeln(f,0); writeln (0);
     end;
 
close(f);
readln;
end.

type
mas=array[0..50] of byte;
 
procedure rec (n:integer; var a:mas);
var
i,j,k,l:integer;
begin
a[0]:=0;
j:=1;
k:=0;
for i:=1 to n do begin
inc(k);
if k=j then begin
a[i]:=1;
k:=0;
inc(j);
end;
end;
end;
 
var
a:mas;
n:integer;
begin
readln(n);
rec(n,a);
writeln(a[n-1]);
readln
end.

program Project1;
 
var
  N, K, M : Integer;
  StrTmp : String;
begin
  repeat
    Writeln('0,10100100010000100000');
    Writeln('Vvedite N >= 0:');
    Readln(N);
    K := 1;
    M := 2;
    while K < N do begin
      K := K + M;
      M := M + 1;
    end;
    if K = N then begin
      Writeln('Na Pozicii ', N, ' raspolojena cifra 1');
    end else begin
      Writeln('Na Pozicii ', N, ' raspolojena cifra 0');
    end;
    Writeln('Prodoljit - ENTER. Vihod - luboi sumvol + ENTER.');
    Readln(StrTmp);
  until StrTmp <> '';
end.

Позиции: 0 1 2 3 4 5 6 7 8 9 10
Цифры:   0,1 0 1 0 0 1 0 0 0 1 ...

var
  n:string[51];
begin
  readln(n);

Позиция - т. е. N          кол-во единиц
55                         10
50 50                      100
500 500                    1 000
5 000 5 000                10 000
50 000 50 000              100 000
500 000 500 000            1 000 000
5 000 000 5 000 000        10 000 000
50 000 000 50 000 000      100 000 000
500 000 000 500 000 000    1 000 000 000
...