Cod sursa(job #141023)

Utilizator RichiUngur Richard-Alex Richi Data 22 februarie 2008 17:41:14
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.71 kb
var v,fi:array [1..1000000] of longint;
    i,n,j,nr:longint;
    s:int64;
begin
 assign(input,'fractii.in'); reset(input);
 assign(output,'fractii.out'); rewrite(output);
 readln(n);
 for i:=2 to trunc(sqrt(n)) do
  if v[i]=0 then
   for j:=2 to n div i do v[i*j]:=i;
{am efectuat Ciurul lui Eratostene}
 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(2*s+1);
 close(input); close(output);
end.