Cod sursa(job #279181)

Utilizator andreivFMI - vacaroiu andrei andreiv Data 12 martie 2009 18:23:56
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.7 kb
program fractii;
var v,fi:array[1..10000000]of longint;
   i,n,j,nr:longint;
   s:int64;
   f,g:text;
begin
assign(f,'fractii.in');
assign(g,'fractii.out');
reset(f);
rewrite(g);
read(f,n);
for i:=2 to n div 2 do
  if v[i]=0 then
for j:=2 to n div i do v[i*j]:=i;
for i:=2 to trunc(sqrt(n)) do
   if v[i]=0 then begin
     nr:=i;
     while nr<=n do begin
       fi[nr]:=nr-nr div i; nr:=nr*i;
     end;
   end;
 for i:=2 to n do
   if fi[i]=0 then
     if v[i]=0 then fi[i]:=i-1
       else begin
         nr:=i;
         while nr mod v[i]=0 do nr:=nr div v[i];
           fi[i]:=fi[nr]*fi[i div nr];
         end;
for i:=1 to n do s:=s+fi[i];
writeln(g,2*s+1);
close(f);close(g);
end.