Cod sursa(job #52231)

Utilizator h_istvanHevele Istvan h_istvan Data 18 aprilie 2007 09:56:16
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.17 kb
program fractii;
var f:text;
    n,i,p,exp,m:longint;
    t:array[1..1000000] of longint;
    e:extended;

procedure bont(x:longint);
var i:longint;
begin
     p:=0;
     i:=2;
     while ((x>1) and (i<=trunc(sqrt(n)))) do
     begin
          if(x mod i = 0) then
          begin
               p:=i;
               exp:=1;
               x:=x div i;
               while(x mod i = 0) do
               begin
                    x:=x div i;
                    exp:=exp+1;
               end;
               m:=x;

               break;
          end;
          i:=i+1;
     end;
     if(p=0) then
     begin
          p:=x;
          m:=1;
          exp:=1;
     end;
end;

function pwr(a,e:longint):longint;
var i,er:longint;
begin
     er:=1;
     for i:=1 to e do
         er:=er*a;
     pwr:=er;
end;

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

     e:=1;
     t[1]:=1;
     for i:=2 to n do
     begin
          bont(i);
          t[i]:=(p-1)*pwr(p,exp-1)*t[m];
          e:=e+2*t[i];
     end;

     assign(f,'fractii.out');
     rewrite(f);
     writeln(f,e);
     close(f);
end.