Cod sursa(job #149450)

Utilizator DonPushmeMilitaru Adrian DonPushme Data 5 martie 2008 18:56:44
Problema Fractii Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.99 kb
type vec=array[1..1000000] of integer;
var v,f:vec;
    n,i,j,s:longint;

procedure ciur(n:longint);
var i,j,pow:longint;
begin
for i:=2 to n do
	if v[i]=0 then
		begin
		j:=i+i;
		while j<=n do
			begin
			v[j]:= 1;
			j:=j+i;
			end;
		end;
end;

procedure totient(var n:longint);
var i,j,j1,k:longint;
begin
f[1]:=1;
for j:=2 to n do
        if v[j]=0 then f[j]:=j-1
                  else begin
                       i:=2;
                       while (j mod i) <>0 do inc(i);

                       j1:=j;
                       k:=0;

                       while j1 mod i=0 do j1:=j1 div i;

                       f[j]:=(i-1)*f[j1]*(j div (j1*i));
                       end;

end;

begin {main}
assign(input,'fractii.in');reset(input);
assign(output,'fractii.out');rewrite(output);

read(n);

fillchar(v,sizeof(v),0);
fillchar(f,sizeof(f),0);

ciur(n);
totient(n);

for i:=2 to n do
        s:=s+f[i];
write(s*2+1);
close(input);close(output);
end.