Cod sursa(job #197337)

Utilizator RobybrasovRobert Hangu Robybrasov Data 3 iulie 2008 17:39:04
Problema Fractii Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.08 kb
var v:array[1..10001] of longint;
    c:array[1..50001] of boolean;
    n,i:longint;
    k:integer;
    kont:int64;
    f:text;

procedure ciur(x:longint);
var i,j,t:longint;
begin
  v[1]:=2;
  k:=1;
  i:=3;
  t:=trunc(sqrt(x));
  while i<=t do
    begin
      if c[i]=false then
        begin
          inc(k);
          v[k]:=i;
          j:=sqr(i);
          while j<=x do begin c[j]:=true; inc(j,i); end;
        end;
      inc(i,2);
    end;
  if not odd(i) then inc(i);
  while i<=x do
    begin
      if c[i]=false then begin inc(k); v[k]:=i; end;
      inc(i,2);
    end;
end;

function phi(x:longint):longint;
var k:longint; p:int64;
begin
  p:=x; k:=1;
  while (v[k]>0) and (v[k]<=x shr 1) do
    begin
      if x mod v[k]=0 then dec(p,p div v[k]);
      inc(k);
    end;
  if p=x then phi:=x-1
  else phi:=p;
end;

begin
  assign(f,'fractii.in');
  reset(f);
  read(f,n);
  close(f);
  ciur(50000);
  assign(f,'fractii.out');
  rewrite(f);
  if n=1 then write(f,1)
  else
    begin
      kont:=0;
      for i:=2 to n do inc(kont,phi(i));
      write(f,kont shl 1+1);
    end;
  close(f);
end.