Cod sursa(job #200471)

Utilizator theratmantheratman theratman Data 24 iulie 2008 10:19:24
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.54 kb
var f,g:text;
    a:array[1..1000000] of longint;
    nr:qword;
    n,p,x,i,t:longint;
begin
assign(f,'fractii.in');reset(f);
assign(g,'fractii.out');rewrite(g);
read(f,n);
a[1]:=n;
for i:=2 to n do begin
 t:=0;
 if a[i]=0 then begin
  a[i]:=n-(n div i);
  t:=1;
 end;
 x:=i+i;
 if t=1 then
 while x<=n do begin
  if a[x]<>0 then begin
   p:=n-(n div i);
   a[x]:=a[x]-(n-p-1);
  end;
  if a[x]=0 then a[x]:=n-(n div i);
  inc(x,i);
 end;
end;
nr:=0;
for i:=1 to n do nr:=nr+a[i];
writeln(g,nr);
close(f);
close(g);
end.