Cod sursa(job #2869)

Utilizator Adrian001Vladulescu Adrian Adrian001 Data 19 decembrie 2006 18:05:29
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.64 kb
Program cel;
var f,g:text;
    n,nr,a,x,d:longint;
    nr1,nr2,nr3:integer;
Begin
Assign(f,'fractii.in');Reset(f);
Assign(g,'fractii.out');Rewrite(g);
Read(f,n);
nr:=n;
a:=2;
While a<=n do
 Begin
  d:=2;
  x:=a;
  nr1:=0;
  nr2:=n;
  nr3:=1;
  repeat
   If x mod d=0 then Begin
                      While x mod d=0 do x:=x div d;
                      nr2:=nr2-(n div d);
                      inc(nr1);
                      nr3:=nr3*d;
                     end;
   inc(d);
  until x=1;
  nr:=nr+nr2;
  If (d-1<>a) and (nr1>1) then nr:=nr+n div nr3;
  inc(a);
 end;
Write(g,nr);
Close(f);
Close(g);
end.