Cod sursa(job #42839)

Utilizator adalLica Adela adal Data 29 martie 2007 16:07:20
Problema Fractii Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.23 kb
program fractii;
var v:array[0..10000] of byte;
    b:array[0..100000] of longint;
    i,j,s,n,m,nr,x,y,p:longint;
    ok:boolean;
    a:array[0..100000] of longint;
    f,g:text;
procedure ciur;
var i,j:longint;
begin
  i:=1;
  while ((i*i) shl 1)+(i shl 1) <=n do begin
    if ((v[i shr 3] shr (i and 7)) and 1 )=0 then begin
      j:=((i*i) shl 1)+ (i shl 1);
      while 2*j+1<=n do begin
        v[j shr 3]:=v[j shr 3] or (1 shl (j and 7));
        j:=j +(i shl 1)+1;
      end;
    end;
    inc(i);
  end;
  b[0]:=1; b[1]:=2;
  for i:=1 to n do
    if ((v[i shr 3] shr (i and 7)) and 1)=0 then
      if (2*i+1<=n) then begin
        inc(b[0]); b[b[0]]:=2*i+1;
      end;
end;

begin
 assign(f,'fractii.in'); reset(f);
 assign(g,'fractii.out'); rewrite(g);
 readln(f,n);
 a[1]:=1;
 ciur; s:=1;
 for i:=2 to n do begin
   j:=1; ok:=false; x:=i;
   while ok=false do begin
      p:=1; nr:=0;
      while (x mod b[j]=0) do begin
        p:=p*b[j]; inc(nr);
        x:=x div b[j];
        ok:=true;
      end;
      inc(j);
   end;
   p:=p div b[j-1];
   if (nr=1) and(x=1) then a[i]:=b[j-1]-1
   else a[i]:=(b[j-1]-1)*p*a[i div (p*b[j-1])];
   s:=s+2*a[i];
 end;
 writeln(g,s);
 close(g); close(f);
end.