Cod sursa(job #73015)

Utilizator mlazariLazari Mihai mlazari Data 16 iulie 2007 11:23:03
Problema Fractii Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.65 kb
Program Fractii;
var n,NPr,nP : longint;
    Pr : array[1..78500] of longint;
    P : array[1..10] of longint;
    answer : real;

procedure Citeste;
var Intrare : text;
begin
  assign(Intrare,'fractii.in');
  reset(Intrare);
  readln(Intrare,n);
  close(Intrare);
end;

procedure Prim(num : longint);
var Pri : boolean;
    j,radical : longint;
begin
  Pri:=true;
  j:=1;
  radical:=trunc(sqrt(num));
  while Pri and (Pr[j]<=radical) do
   begin
     Pri:=num mod Pr[j]<>0;
     j:=j+1;
   end;
  if Pri then
   begin
     NPr:=NPr+1;
     Pr[NPr]:=num;
   end;
end;

procedure CalculeazaNumerePrime;
var i : longint;
begin
  NPr:=1;
  Pr[1]:=2;
  for i:=3 to 1000000 do Prim(i);
end;

procedure VerificaPrim(var nr : longint; prim : longint);
begin
  if (nr>1) and (nr mod prim=0) then
   begin
     while (nr>1) and (nr mod prim=0) do nr:=nr div prim;
     nP:=nP+1;
     P[nP]:=prim;
   end;
end;

procedure Descompunere(nr : longint);
var i : longint;
begin
  nP:=0;
  i:=1;
  while nr>1 do
   begin
     VerificaPrim(nr,Pr[i]);
     i:=i+1;
   end;
end;

function fi(nr : longint) : longint;
var i : integer;
begin
  Descompunere(nr);
  for i:=1 to nP do nr:=nr div P[i];
  for i:=1 to nP do nr:=nr*(P[i]-1);
  fi:=nr;
end;

procedure Calculeaza;
var realN : real;
    i : longint;
begin
  CalculeazaNumerePrime;
  answer:=0;
  for i:=2 to N do answer:=answer+fi(i);
  answer:=answer*2+1;
end;

procedure Scrie;
var Iesire : text;
begin
  assign(Iesire,'fractii.out');
  rewrite(Iesire);
  write(Iesire,answer:0:0);
  close(Iesire);
end;

begin
  Citeste;
  Calculeaza;
  Scrie;
end.