Cod sursa(job #68687)

Utilizator mlazariLazari Mihai mlazari Data 29 iunie 2007 07:53:43
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.01 kb
Program Fractii;
var N : longint;
    raspuns : real;

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

procedure Ordona(var a,b : longint);
var aux : integer;
begin
  if b<a then
   begin
     aux:=a;
     a:=b;
     b:=aux;
   end;
end;

function Notpr(a,b : longint) : integer;
begin
  while b mod a<>0 do
   begin
     b:=b-a;
     Ordona(a,b);
   end;
  if a>1 then Notpr:=1 else Notpr:=0;
end;

function Numar(a : longint) : longint;
var nr,i : longint;
begin
  nr:=0;
  for i:=a to N do nr:=nr+Notpr(a,i);
  Numar:=2*nr-1;
end;

procedure Calculeaza;
var realN : real;
    i : longint;
begin
  realN:=N;
  raspuns:=sqr(realN);
  for i:=2 to N do raspuns:=raspuns-Numar(i);
end;

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

begin
  Citeste;
  Calculeaza;
  Scrie;
end.