NKABD - Số phong phú

Tác giả: flashmt

Ngôn ngữ: Pascal

const fi='';
      fo='';

var x,y,re:longint;
    a:array[1..100000] of byte;
    p:array[2..100000] of byte;
    q:array[0..100000] of longint;

procedure prime;
var i,j,k:longint;
begin
     fillchar(a,sizeof(a),0);
     fillchar(p,sizeof(p),0);
     fillchar(q,sizeof(q),0);
     for i:=2 to trunc(sqrt(y)) do
         if p[i]=0 then
         begin
              j:=i*i;
              while j<=y do
              begin
                   p[j]:=1;
                   j:=j+i;
              end;
         end;
     for i:=2 to y do
         if p[i]=0 then
         begin
              inc(q[0]);
              q[q[0]]:=i;
         end;

     for i:=2 to y do
         if p[i]=0 then a[i]:=2;

     for i:=4 to y do
         if p[i]=0 then
         begin
              j:=1;
              while q[j]*i<=y do
              begin
                   a[q[j]*i]:=2;
                   inc(j);
              end;
         end;

end;

procedure rf;
begin
     read(x,y);
end;

function check(x:longint):boolean;
var i,j:longint;
begin
     j:=0;
     for i:=2 to trunc(sqrt(x)) do
         if x mod i = 0 then j:=j+i+x div i;
     if sqr(trunc(sqrt(x)))=x then j:=j-trunc(sqrt(x));
     check:=(j+1>x);
end;

procedure pr;
var i,j,k:longint;
begin
     prime;
     re:=0;
     for i:=x to y do
          if (i mod 6 = 0) and (i<>6) then a[i]:=1
          else
          begin
               if a[i]<>0 then continue;
               if check(i) then
               begin
                    j:=i;
                    while j<=y do
                    begin
                         a[j]:=1;
                         j:=j+i;
                    end;
               end;
          end;
     for i:=x to y do
         if a[i]=1 then inc(re);
end;

procedure wf;
begin
     write(re);
end;

begin
     rf;
     pr;
     wf;
end.

Download