Cod sursa(job #166455)

Utilizator kolapsysPostelnicu Dan Marian kolapsys Data 28 martie 2008 00:42:08
Problema Fractii Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.4 kb
type vector=array[1..1000000] of longint;
var st:int64;
    n,i:longint;
    f,g:text;
    a:vector;
{---Functia totient <=> Indicatorul lui Euler---}
function t(n:longint):longint;
var p:real;
    i:longint;
begin
        {ciur(n,a);}
        if n=0 then t:=1
               else begin
                        p:=n;
                        for i:=2 to n div 2 do
                                if (a[i]=0) and (n mod i=0) then p:=p*(1-1/i);
                        t:=trunc(p);
                        end;
end;
{---Sfarsit functie totient---}
{---Ciurul lui Eratostene---}
procedure ciur(n:longint;var a:vector);
var i,j:longint;
begin
        a[1]:=1;
        i:=2;
        while i<=sqrt(n) do
                begin
                j:=sqr(i);
                while j<=n do
                        begin
                        a[j]:=t(j);
                        j:=j+i;
                        end;
                if i=2 then i:=3
                       else i:=i+2;
                end;

end;
{---Sfarsit Ciurul lui Eratostene---}
begin
        assign(f,'fractii.in'); reset(f);
        assign(g,'fractii.out'); rewrite(g);
        readln(f,n);
        ciur(n,a);
        st:=1;
        for i:=2 to n do begin
                      if a[i]=0 then a[i]:=i-1;
                      st:=st+2*a[i];
                      end;
        write(g,st);
        close(f); close(g);
end.