Cod sursa(job #600963)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 4 iulie 2011 14:54:54
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.96 kb
Program fractii_2;
 var a:array [1..500000,1..2] of longint;
  i,j,n,s,k:longint;
  fi,fo:text;
begin
 assign(fi,'fractii.in');
  reset(fi);
   read(fi,n);
 assign(fo,'fractii.out');
  rewrite(fo);
  k:=1;
 for i:=1 to (n div 2+n mod 2) do
  for j:=1 to 2 do begin
   a[i,j]:=k;
   inc(k);
   if k>n then a[i,j]:=0;
   end;
 s:=(n div 2+n mod 2)*(n div 2)*2+1;
 for i:=2 to ((n div 2+n mod 2) div 2)+1 do
  s:=s-((n div 2) div a[i,1])*2;
 for i:=2 to ((n div 2+n mod 2) div 2) do begin
 k:=0;
  for j:=i+1 to (n div 2+n mod 2) do
   if a[j,1] mod a[i,1]<>0 then s:=s+2
                             else begin
                                  s:=s-((n div 2) div a[i,1])*2-2*k;
                                  inc(k);
                                  end;
                                  end;
 for i:=(((n div 2+n mod 2) div 2)+1) to ((n div 2+n mod 2)-1) do
  s:=s+(n div 2+n mod 2-i)*2;
  s:=s+(n div 2+n mod 2-1)*2;
 write(fo,s);
 close(fo);
end.