Cod sursa(job #190005)

Utilizator luigiPacala luigi Data 19 mai 2008 17:35:43
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.1 kb
var v:array[1..1000000] of int64;
    f:text;
    n,s,r,nr,pro,sum,j,i,z,q,a,sad:int64;
begin
assign(f ,'fractii.in');
reset(f);
read(f,n);
close(f);
s:=n;
i:=2;
r:=0;
while i<=n do
 begin
  nr:=i;
  a:=2;
  sum:=i;
  pro:=1;
  v[1]:=0;
  sad:=0;
  while (a<=i div 2) and (nr<>1) do
   begin
      if nr mod a=0 then
       begin
        nr:=nr div a;
        inc(r);
        v[r]:=a;
        sum:=sum*(v[r]-1);
        pro:=pro*v[r];
       while  (nr mod a=0) and (nr<>1) do
         nr:=nr div a;
       end;
   inc(a);
   end;
   if r=0 then
    begin
    sum:=sum-i;
    sum:=sum+i-1;
    end;
  if r<>0 then
  begin
   sum:=sum div pro;
   j:=i+1;
   while j<=n do
   begin
      z:=1;
      while z<=r do
      begin
       if j mod v[z]=0 then
        z:=1000000;
       z:=z+1;
      end;
     if z<>1000001 then
      sum:=sum+1;
    j:=j+1;
   end;
  end
   else
  sum:=sum+ n-i-((n-i) div i);
  s:=s+sum;
z:=1;

while z<=r do
begin
v[z]:=0;
inc(z);
end;
r:=0;
inc(i);
 end;
assign(f ,'fractii.out');
rewrite(f);
write(f,s);
close(f);
end.