Cod sursa(job #254170)

Utilizator MihaiBunBunget Mihai MihaiBun Data 6 februarie 2009 22:04:34
Problema Fractii Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.2 kb
program frac;
var f:text;
    n,i,j,x,m,a,q:longint;
    numa:int64;
    p:array[1..500000] of longint;
    er:array[1..500000] of 0..1;
begin
  assign(f,'fractii.in');
  reset(f);
  readln(f,n);
  close(f);
  assign(f,'fractii.out');
  rewrite(f);
  p[1]:=2;m:=1;
  i:=1;
  repeat
      i:=i+2;
      if er[i]=0 then begin
                        m:=m+1;
                        p[m]:=i;
                        j:=i*i;
                        while j<=n do
                            begin
                            er[j]:=1;
                            j:=j+2*i
                            end;
                      end;
  until i>n-2;
  numa:=0;
  for i:=2 to n do
    begin
      a:=i;
      j:=1;
      x:=i;
      while (p[j]*p[j]<=a)and(a>1) do
           begin
             if a mod p[j]=0 then begin
                                   x:=(x div p[j])*(p[j]-1);
                                   a:=a div p[j];
                                   while a mod p[j]=0 do a:=a div p[j]
                                  end;
             j:=j+1;
           end;
      if a>1 then x:=(x div a)*(a-1);
      numa:=numa+x
    end;
   writeln(f,numa*2+1);
   close(f);


end.