Cod sursa(job #315482)

Utilizator AndreiDumaAndrei Duma AndreiDuma Data 15 mai 2009 21:52:47
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.79 kb
var a : array[1..1000000] of longint;
    n : longint;
    sum : qword;


procedure citire;
var f:text;
begin
        assign(f,'fractii.in');reset(f);
        readln(f,n);
        close(f);
end;

procedure rez;
var i,j:longint;
begin
        for i:=2 to n do a[i] := i-1;
        for i:=1 to n div 2 do
        begin
                j:=2*i;

                while j<=n do
                begin
                        a[j]:=a[j]-a[i];
                        j:=j+i;
                end;
        end;
        for i:=2 to n do sum := sum + a[i];
        sum := sum*2 + 1;
end;

procedure afisare;
var g:text;
begin
        assign(g,'fractii.out');rewrite(g);
        writeln(g,sum);
        close(g);
end;

begin
        citire;
        rez;
        afisare;
end.