Cod sursa(job #680385)

Utilizator Diana_M08Miholca Diana-Lucia Diana_M08 Data 15 februarie 2012 15:24:51
Problema Fractii Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.21 kb
type sir=array[1..75000] of longint;
var n,poz,j:longint;
    f,g:text;
    d:sir;
    nrfrac,nr:int64;
Procedure descompunere(x:longint;var d:sir;var poz:longint;var nr:int64);
var i,p:integer;
    aux:longint;
    ok:boolean;
begin
i:=1;
ok:=false;
nr:=1;
While (d[i]<=sqrt(x)) do
      begin
      p:=0;
      aux:=x;
      While x mod d[i]=0 do
            begin
            inc(p);
            x:=x div d[i];
            end;
      If p>0 then
      begin
      nr:=nr*(d[i]-1)*aux div x div d[i];
      ok:=true;
      end;
      inc(i);
      end;
If not ok then
   begin
   d[poz]:=x;
   inc(poz);
   nr:=x-1;
   end
   else
   While x<>1 do
         begin
         p:=0;
         aux:=x;
         While x mod d[i]=0 do begin inc(p); x:=x div d[i]; end;
         If p>0 then
         begin
         nr:=nr*(d[i]-1)*aux div x div d[i];
         end;
         inc(i);
         end;
end;
begin
 assign(f,'fractii.in');reset(f);
 assign(g,'fractii.out');rewrite(g);
 read(f,n);
 d[1]:=2; d[2]:=3;
 nrfrac:=0;
 poz:=3;
 For j:=4 to n do
     begin
     descompunere(j,d,poz,nr);
     nrfrac:=nrfrac+nr;
     end;
 writeln(g,nrfrac*2+7);
 close(f);close(g);
end.