Cod sursa(job #68651)

Utilizator mlazariLazari Mihai mlazari Data 28 iunie 2007 22:59:44
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1 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;

function Prim(a : longint) : boolean;
var i : longint;
    P : boolean;
begin
  if a=2 then Prim:=true
   else
    begin
      P:=true;
      for i:=2 to trunc(sqrt(a)) do
       if a mod i=0 then
        begin
          P:=false;
          break;
        end;
      Prim:=P;
    end;
end;

procedure Calculeaza;
var realN,reductibile,cit : real;
    i : longint;
begin
  realN:=N;
  reductibile:=realN-1;
  for i:=2 to trunc(sqrt(N)) do
   if Prim(i) then
    begin
      cit:=N div i;
      reductibile:=reductibile+sqr(cit)-cit;
    end;
  raspuns:=sqr(realN)-reductibile;
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.