Cod sursa(job #315388)

Utilizator AndreiDumaAndrei Duma AndreiDuma Data 15 mai 2009 12:21:18
Problema Fractii Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.77 kb
var a:array[1..1000000] of boolean;
    f,g:text;

    i,n:longint;
    sum:qword;

procedure generate;
var j:longint;

begin
        for i:=2 to n do a[i] := true;
        for i:=2 to n div 2 do
        begin
                if not a[i] then continue;
                for j:=2 to n div i do a[i*j] := false;
        end;
end;

function tot(x:longint):longint;
var r:real;
    i:longint;
begin
        r:=1;
        for i:=2 to x do if a[i] and (x mod i=0)
                        then r:=r*(1-1/i);
        r:=r*x;
        tot := round(r);
end;

begin
assign(f,'fractii.in');reset(f);
assign(g,'fractii.out');rewrite(g);

readln(f,n);

generate;

sum:=0;
for i:=n downto 2 do sum:=sum+tot(i);

sum:=sum*2+1;

writeln(g,sum);
close(g);

end.