Cod sursa(job #387969)

Utilizator energizerBunnyCicu Mihai energizerBunny Data 28 ianuarie 2010 21:01:54
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.1 kb
program pascal;
var
 f:text;
 v:array[1..1000000] of byte;
 n,calcul:longint;

procedure prime;
var
  i,j:longint;
begin
  for i:=1 to n do
    v[i]:=1;
  for i:=2 to trunc(sqrt(n)) do
    if v[i] = 1 then
      for j:=2 to n div i do
        v[j*i]:=0;
end;

function rid_p(a,b:longint):longint;
{functie de ridicare la puterea b a numarului a}
var
 t:integer;
 put:longint;
begin
  put:=1;
  for t:=1 to b do
    put:=put*a;
  rid_p:=put;
end;

procedure rezultat;
var
 i,j,fi,x,putere:longint;
begin
  calcul:=n*2-1;
  for i:=2 to n do begin
    x:=i;
    fi:=1;
    for j:=2 to (i div 2) do
      if x=1 then break
      else
      if (v[j]=1) and (x mod j = 0) then begin
        putere:=0;
        while (x mod j = 0) and (x<>1) do begin
          inc(putere);
          x:=x div j;
        end;
        fi:=fi * (j-1)*rid_p(j,putere-1);
      end;
    calcul:=calcul+fi;
  end;
end;

begin
  assign(f,'fractii.in');
  reset(f);
  read(f,n);
  close(f);

  prime;
  rezultat;

  assign(f,'fractii.out');
  rewrite(f);
  write(f,calcul);
  close(f);
end.