Cod sursa(job #278049)

Utilizator THE_GAMEAndrei Alexandru THE_GAME Data 12 martie 2009 08:33:25
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.76 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.