Cod sursa(job #165840)

Utilizator kolapsysPostelnicu Dan Marian kolapsys Data 26 martie 2008 23:15:43
Problema Fractii Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.54 kb
type vector=array[1..1000000] of byte;
var n,i,s:int64;
    f,g:text;
    a:vector;
{---Functia putere---}

{---Sfarsit functie putere---}
{---Ciurul lui Eratostene---}
procedure ciur(n:int64;var a:vector);
var i,j:int64;
begin
        a[1]:=1;
        i:=2;
        while i<=trunc(sqrt(n)) do
                begin
                j:=sqr(i);
                while j<=n do
                        begin
                        a[j]:=1;
                        j:=j+i;
                        end;
                if i=2 then i:=3
                       else i:=i+2;
                end;
end;
{---Sfarsit Ciurul lui Eratostene---}
{---Functia totient <=> Indicatorul lui Euler---}
function t(n:int64):int64;
var p:real;
    i:int64;
begin
        {ciur(n,a);}
        if n=0 then t:=1
               else begin
                    p:=n;
                    i:=1;
                    while i<=n do
                        begin
                        if (a[i]=0) and (n mod i=0) then p:=p*(1-1/i);
                        i:=i+1;
                        end;
                    t:=trunc(p);
                    end;
end;
{---Sfarsit functie totient---}
begin
        assign(f,'fractii.in'); reset(f);
        assign(g,'fractii.out'); rewrite(g);
        readln(f,n);
        ciur(n,a);
        s:=1; i:=2;
        while i<=n do
            begin
            if a[i]=0 then s:=s+2*(i-1)
                      else s:=s+2*t(i);
            i:=i+1;
            end;
        writeln(g,s);
        close(f); close(g);
end.