Cod sursa(job #2867)

Utilizator Adrian001Vladulescu Adrian Adrian001 Data 19 decembrie 2006 17:50:04
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.59 kb
Program cel;
var f,g:text;
    n,nr,a,x:longint;
    d,nr1,nr2: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;
  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);
                     end;
   inc(d);
  until x=1;
  nr:=nr+nr2;
  If (d-1<>a) and (nr1>1) then nr:=nr+n div a;
  inc(a);
 end;
Write(g,nr);
Close(f);
Close(g);
end.