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.