Cod sursa(job #12847)

Utilizator marius21Petcu Marius marius21 Data 4 februarie 2007 22:32:34
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.59 kb
var a:array[1..1000000]of boolean;
x,k,nrr,i,j,n,nr:longint;
ok:boolean;
f,g:text;
begin
assign(f,'fractii.in');
assign(g,'fractii.out');
reset(f);
rewrite(g);
read(f,n);
nr:=n-1;
for i:=2 to n do begin
x:=i;
j:=1;
while x>1 do begin
inc(j);
if x mod j=0 then begin
x:=x div j;
if not ok then begin
nrr:=n-i;
 for k:=i div j+1 to n div j  do
  if not a[k*j] then begin
  dec(nrr);
  a[k*j]:=true;
 end;
nr:=nr+nrr;
for k:=i+1 to n do if a[k] then a[k]:=false;
end;
dec(j);
ok:=true;
end
else ok:=false;
end;
end;
nr:=nr*2+1;
writeln(g,nr);
close(f);
close(g);
end.