Pascal

Modified: Wednesday, 22-12-2021 07:00 AM

program so_nt_kep;
uses crt;
var
   nt:array[1..1000000]of longint;
   c:array[1..100000] of longint;
   d:array[1..100000] of int64;
   e:array[1..10000] of int64;
   int,ic,id,ie,k:longint;
//--------------------------------
function snt(n:int64):boolean;
var m: int64;
   i: longint;
begin
   m := trunc(sqrt(n));
   for i := 2 to m do
   if (n mod i = 0) then begin exit(false);break; end;
   exit(true);
end;
//--------------------------------
procedure ds_nt;
var 
   m:longint;
begin
   int:=0;                 
   for m :=2 to 100000 do
   begin
      if snt(m) then
      begin
         inc(int);
         nt[int]:=m;
      end;
   end;
end;
//--------------------------------
procedure tao_m_c;
var
   i,j:longint;    
   b:boolean;
begin
   ic:=0;
   i:=2;
   writeln('=====================================');
   writeln('  dang tao csdl so nguyen to < 10^6...');
   while i<= 250000 do
   begin     
      b:=true;
      for j:=1 to int do
      while nt[j]<=i do
      begin
         if i mod nt[j]=0 then
         b:=false;
         break;
      end;
      if b=true then
      begin
         inc(ic);
         c[ic]:=i;
      end;
      inc(i);
   end;
   writeln('  co tat ca ',ic,' so nguyen to!');
   writeln('=====================================');
end;
//================================
procedure tao_m_d;
var i:longint;
    s1,s2:string;
    code:longint;
begin
   i:=0;
   id:=0;
   writeln('  dang ghep doi cac so nguyen to...');
   while (i*2+1)<=ic do
   begin
      str(c[i*2+1],s1);
      str(c[i*2+2],s2);
      inc(id);
      val((s1+s2),d[id],code);
      inc(i);
   end;
   writeln('  co tat ca ',id,' cap so!');
   writeln('=====================================');
end;
//================================
procedure tao_m_e;
var i,j,k:longint; b:boolean;
begin
   ie:=0;
   writeln('  dang tao csdl so nguyen to kep ...');
   for i:=1 to id do
   for k:=1 to int do
   begin
      b:=true;
      while nt[k]<=d[i] do
      if d[i] mod nt[k]=0 then
      begin
         b:=false;
         break;
      end;
      if b=true then
      begin            
         inc(ie);
         e[ie]:=d[i];
      end;
   end;
   writeln('  co tat ca ',ie,' so nguyen to kep');
   writeln('=====================================');
end;
//================================
begin
   textcolor(white);
   textbackground(blue);
   clrscr; 
   ds_nt;     
   writeln('danh sach nt co: ',int,' so');
   tao_m_c;
   tao_m_d;
   tao_m_e;
   writeln('  da tao xong csdl');
   while not k<=0 do
      begin
         write('  ban muon xem so thu may? k= '); readln(k);
         write('  so nguyen to kep thu ',k,' la: ',e[k]);
         readln;
      end;
end.