Cod sursa(job #14619)

Utilizator pauldbPaul-Dan Baltescu pauldb Data 9 februarie 2007 12:47:08
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.63 kb
var v:array[1..15000] of byte;
  b:array[0..50000] of longint;
  pphi,phi:array[1..50000] of longint;
  ok:array[1..50000] of boolean;
  n,i,j:longint;sum:int64;bun:boolean;
  f,g:text;

procedure ciur(n:longint);
var i,j:longint;
begin
fillchar(v,sizeof(v),0);
fillchar(b,sizeof(b),0);
fillchar(phi,sizeof(phi),0);
fillchar(ok,sizeof(ok),0);
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 (j shl 1) +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;phi[2]:=1;ok[2]:=true;
for i:=1 to n do
  if ((v[i shr 3] shr (i and 7)) and 1)=0 then
    if i shl 1 +1<=n then begin
      inc(b[0]);
      b[b[0]]:=i shl 1 +1;
      phi[ b[b[0]] ]:=b[b[0]]-1;
      ok[b[b[0]]]:=true;
    end;
end;


procedure cphi(n:longint);
var i,j:longint;
begin
for i:=1 to n do
  if ok[i] then
    for j:=1 to b[0] do
      if b[j]*i>n then break
      else if not(ok[b[j]*i]) then begin
        if i mod b[j]=0 then phi[b[j]*i]:=phi[i]*b[j]
        else phi[b[j]*i]:=phi[i]*(b[j]-1);
        ok[b[j]*i]:=true;
      end;
{for i:=1 to n do begin
  pphi[i]:=i;
  j:=1;
  while (b[j]<=i) and (j<=n) and (j<=b[0]) do begin
    if i mod b[j]=0 then pphi[i]:=(pphi[i]*(b[j]-1)) div b[j];
    inc(j);
  end;
end; }
end;


begin
assign(f,'fractii.in');reset(f);
assign(g,'fractii.out');rewrite(g);
readln(f,n);
ciur(n);
cphi(n);
sum:=0;
phi[1]:=1;
for i:=2 to n do
  sum:=sum+phi[i];
sum:=2*sum+1;
writeln(g,sum);
close(f);
close(g);
end.