Cod sursa(job #24974)

Utilizator AymdTrimbitas Viorel Stefan Aymd Data 4 martie 2007 06:09:26
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.76 kb
var a:array[1..1000000,1..5] of longint;
    b,c:array[1..1000000]of longint;
    n,r,x,i,j,k:longint;
    f,g:text;

begin
assign(f,'fractii.in');
reset(f);
assign(g,'fractii.out');
rewrite(g);
readln(f,n);
for i:=2 to n div 2 do begin
   if b[i]=0 then begin
                  x:=i*2;
                  while x<n+1 do begin
                    b[x]:=b[x]+1;
                    a[x,b[x]]:=i;
                    x:=x+i;
                  end;
                  end;
end;
r:=n;
for i:=2 to n do begin
  for k:=1 to b[i] do c[k]:=n div a[i,k];
  for j:=2 to b[i]-1 do begin
      for k:=j to b[i] do c[k]:=c[k]-c[k] div a[i,j];
  end;
  x:=0;
  if b[i]=0 then x:=n div i;
  for j:=1 to b[i] do x:=x+c[k];
  r:=r+n-x;
end;
write(g,r);
close(g);
end.