Cod sursa(job #148872)

Utilizator DonPushmeMilitaru Adrian DonPushme Data 4 martie 2008 22:24:53
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.66 kb
type vec=array[1..1000000] of integer;
var v,f:vec;

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

begin
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);

for i:=2 to n do
	if v[i]=0 then
		begin
		f[i]:=i-1;
		j:=i+i;
		while j<n do
			begin   
			f[j]:=f[i]*f[j div i];
			j:=j+i;
			end;
		end;
end.