Cod sursa(job #9027)

Utilizator Adrian001Vladulescu Adrian Adrian001 Data 26 ianuarie 2007 13:40:49
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.07 kb
Program cel;
Type vector=array[2..1000000] of boolean;
     vector1=array[2..1000000] of longint;
var f,g:text;
    a:vector;
    phi:vector1;
    n,i,j,p,nr:longint;
Begin
Assign(f,'fractii.in');Reset(f);
Assign(g,'fractii.out');Rewrite(g);
Read(f,n);
fillchar(a,sizeof(a),true);
For i:=2 to trunc(sqrt(n)) do
 If a[i]=true then Begin
                    j:=2;
                    While i*j<=n do
                     Begin
                      a[i*j]:=false;
                      inc(j);
                     end;
                   end;
For i:=2 to n do
 If a[i]=true then phi[i]:=i-1;
i:=2;
While i<=trunc(sqrt(n)) do
 Begin
  p:=i;
  While  i*2<=n do
   Begin
    phi[i*2]:=((i*2) div p)*phi[p];
    a[i*2]:=true;
    i:=i*2;
 end;
 i:=p+1;
end;
For i:=2 to n do
 If a[i]=false then Begin
                     j:=2;
                     While i mod j<>0 do inc(j);
                     phi[i]:=phi[j]*phi[i div j];
                    end;
nr:=0;
For i:=2 to n do nr:=nr+phi[i];
nr:=1+2*nr;
Write(g,nr);
Close(f);
Close(g);
end.