Cod sursa(job #11225)

Utilizator Adrian001Vladulescu Adrian Adrian001 Data 30 ianuarie 2007 21:54:44
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.65 kb
Program cel;
Type vector=array[2..1000000] of boolean;
     vector1=array[2..1000000] of longint;
     dubla=record
      prime,neprime:vector;
     end;
var f,g:text;
    a:dubla;
    phi:vector1;
    n,i,j,p,x,d,fm:longint;
    nr:real;
Begin
Assign(f,'fractii.in');Reset(f);
Assign(g,'fractii.out');Rewrite(g);
Read(f,n);
For i:=2 to n do
 Begin
  a.prime[i]:=true;
  a.neprime[i]:=false;
  phi[i]:=0;
 end;
For i:=2 to trunc(sqrt(n)) do
 If a.prime[i]=true then Begin
                          j:=2;
                          While i*j<=n do
                           Begin
                            a.prime[i*j]:=false;
                            inc(j);
                           end;
                         end;
For i:=2 to n do
 If a.prime[i]=true then phi[i]:=i-1;
i:=2;
While i<=trunc(sqrt(n)) do
 Begin
  p:=i;
  If phi[p]>0 then
  While  i*p<=n do
   Begin
    phi[i*p]:=i*phi[p];
    a.neprime[i*p]:=true;
    i:=i*p;
   end;
 i:=p+1;
end;
For i:=2 to n do
 If (a.prime[i]=false) and (a.neprime[i]=false) then
  Begin
   x:=i;
   d:=2;
   phi[i]:=1;
   repeat
    fm:=0;
    While x mod d=0 do
     Begin
      x:=x div d;
      inc(fm);
     end;
    If fm<>0 then Begin
                   nr:=1;
                   For j:=1 to fm do nr:=nr*d;
                   phi[i]:=phi[i]*phi[round(nr)];
                  end;
    If a.prime[x]=true then d:=x
                       else repeat
                             inc(d);
                            until a.prime[d]=true;
   until x=1;
  end;
nr:=0;
For i:=2 to n do nr:=nr+phi[i];
nr:=1+2*nr;
Write(g,nr:0:0);
Close(f);
Close(g);
end.