Cod sursa(job #188693)

Utilizator FllorynMitu Florin Danut Flloryn Data 9 mai 2008 17:42:45
Problema Fractii Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.08 kb
program pascal;
var f,g:text; v:array[1..1000000] of longint;
    i,d,n,aux:longint;   u:array[1..1000000] of boolean;
    max,nr:int64;

 procedure ex;
 var j:longint;
 begin
  for j:=1 to n do v[j]:=j;
 end;

begin
assign(f,'fractii.in'); reset(f);
assign(g,'fractii.out'); rewrite(g);
read(f,n);
max:=n+n-1;
for i:=1 to n do u[i]:=true;
ex;

 for i:=2 to n do
 if u[i]=true then
  begin
   nr:=0;
   for d:=2 to (i div 2)  do
   if (i mod d=0) and (v[d]<>0) then
      begin
         aux:=d;
         repeat
         if v[aux]<>0 then nr:=nr+1;
         v[aux]:=0;
         aux:=aux+d;
         until aux>n;
      end;

    d:=i;
    aux:=d;
         repeat
         if v[aux]<>0 then nr:=nr+1;
         v[aux]:=0;
         aux:=aux+d;
         until aux>n;
   max:=max+n-nr-1;

   aux:=i;
   u[aux]:=false;
   repeat
   if aux*i<=n then
       begin
             aux:=aux*i;
             max:=max+n-nr-1;
             u[aux]:=false;
       end
       else aux:=aux*i;
  until aux>n;
  ex;
  end;
 write(g,max);
 close(f);
 close(g);
end.