Cod sursa(job #276544)

Utilizator basketbalistu92alexandru catalisan basketbalistu92 Data 11 martie 2009 11:08:05
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.69 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 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(2*s+1);
  close(input);close(output);
  end.