FILE 20210225 102106 TAI LIEU ON THI HOC SINH GIOI MON TIN HOC 2020

CHUYÊN ĐỀ SỐ NGUYÊN LỚN
1. Cộng hai số nguyên lớn
Bước 1: Xử lí làm sao cho hai số ngun có chiều dài bằng nhau
Bước 2: Chuyển từng kí tự trong hai số nguyên lớn vào hai mảng
Bước 3: Tiến hành cộng hai mảng ( Cộng từ phải sang trái)
Bước 4: Xử lí mảng kết quả
Program so_nguyen_lon_cong;
Type mang=array[1..255] of longint;
Var a,b,c:mang;
i,m,code,nho:Longint;
st1,st2:String;
Begin
Write('Nhap so a=');Readln(st1);
Write('Nhap so b=');Readln(st2);
//------------Xu li hai chuoi nhap vao---------------------While (Pos(' ',st1)<>0) do delete(st1,pos(' ',st1),1);
While (Pos(' ',st2)<>0) do delete(st2,pos(' ',st2),1);
While length(st1)>length(st2) do st2:='0'+st2;
While length(st2)>length(st1) do st1:='0'+st2;
//--------------------Thuat toan--------------------------m:=length(st1);
For i:=1 to m do
Begin
val(st1[i],a[i],code);
val(st2[i],b[i],code);
End;
nho:=0;
For i:=m downto 1 do
Begin
c[i]:=a[i]+b[i]+nho;
nho:=c[i] div 10;
End;
Writeln('Ket qua phep cong la:');

//-----------------Xu li mang ket qua----------------------For i:=2 to m do c[i]:=c[i] mod 10;
For i:=1 to m do Write(c[i]);
Readln;
End.
2. Trừ hai số nguyên lớn
Bước 1: Xử lí làm sao cho hai số nguyên có chiều dài bằng nhau và xác định số trừ và số
bị trừ
Bước 2: Chuyển từng kí tự của hai số bị trừ và số trừ vào 2 mảng
Bước 3: Tiến hành trừ hai mảng ( Trừ từ phải sang trái)
Bước 4: Xử lí mảng kết quả
Program so_nguyen_lon_tru;
Type mang=array[1..255] of longint;
Var a,b,c:mang;
i,m,code:Longint;
st1,st2,sbt,st,dau:String;
Begin
Write('Nhap so bi tru=');Readln(st1);
Write('Nhap so tru=');Readln(st2);
//------------Xu li hai chuoi nhap vao---------------------Trang 1


While (Pos(' ',st1)<>0) do delete(st1,pos(' ',st1),1);
While (Pos(' ',st2)<>0) do delete(st2,pos(' ',st2),1);
While length(st1)>length(st2) do st2:='0'+st2;
While length(st2)>length(st1) do st1:='0'+st1;
//----------------------Tim so bi tru va tim so tru-------If st1>st2 then
Begin
sbt:=st1; st:=st2;dau:='';
End
Else

Begin
sbt:=st2; st:=st1;dau:='-';
End;
//--------------------Thuat toan--------------------------m:=length(sbt);
For i:=1 to m do
Begin
val(sbt[i],a[i],code);
val(st[i],b[i],code);
End;
For i:=m downto 1 do
Begin
c[i]:=a[i]+10-b[i];
If a[i]End;
Writeln('Ket qua phep tru la:');
Write(dau);
//-----------------Xu li mang ket qua----------------------For i:=2 to m do c[i]:=c[i] mod 10;
For i:=1 to m do Write(c[i]);
Readln;
End.

3. Số nguyên lớn nhân N
Bước 1: Chuyển từng kí tự của số nguyên lớn vào mảng A
For i:=1 to length(st) do val(st[i], c[i], code);
Bước 2: Tiến hành tính mảng kết quả
Nho:=0;
For i:= length(st) downto 1 do
Begin
C[i]:=a[i]*N +nho;
Nho:=c[i] div 10;

End;
Bước 3: Xử lí mảng kết quả
For i:=2 to length(st) do c[i]:= c[i] mod 10
Bài 4. Nhân hai số nguyên lớn:
Program nhanhaisonguyen;
Type mang=array[1..255] of Integer;
Var a,b,c:mang;
n,m,i,j,code:Integer;
st1,st2:String;
Begin
Write('st1=');Readln(st1);
Trang 2


Write('st2=');Readln(st2);
n:=length(st1);m:=length(st2);
//-------------Đưa vào mảng A[n], B[m] để tính--------For i:= 1 to n do val(st1[i],a[i],code);
For i:= 1 to m do val(st2[i],b[i],code);
//----------Tinh mang ket qua------------------------------C[n+m]:=0;
For i:= n downto 1 do
For j:=m downto 1 do c[i+j]:=c[i+j]+a[i]*b[j];
//--------------------Xu li mang ket qua-------------------For i:=m+n downto 2 do
Begin
c[i-1]:=c[i-1]+c[i] div 10;
c[i]:=c[i] mod 10;
End;
//-----------------------in ket qua----------------------------If c[1]=0 then j:=2 else j:=1;
For i:=j to m+n do Write(c[i]);
Readln;
End.

Bài 5: Nhập một số nguyên lớn và nhập n (0dư của phép chia số nguyên lớn cho n.
Program chia;
Type mang=array[1..100] of Longint;
Var a,c:mang;
n,m,i,j,code,x:Longint;
st:String;
Begin
Write('st=');Readln(st);
m:=length(st);
For i:=1 to m do val(st[i],a[i],code);
i:=1;
Write('n=');Readln(n);
Write('Thuong: ');
While iBegin
if a[i]Write(x div n);
x:=x mod n;
i:=i+1;
a[i]:=x;
End;
Writeln;
Write(' du ',x);
Readln;
End.

Trang 3

CHUYÊN ĐỀ SỐ LA MÃ
Bài 1: Chuyển số La mã sang số hệ cơ số 10
Program so_la_ma;
Var a:Array['A'..'Z'] of longint;
i,n,m:Longint;
so:String;
Begin
Write('Nhap so la ma=');Readln(so);
For i:=1 to length(so) do
If so[i] in ['a'..'z'] then so[i]:=Upcase(so[i]);
a['I']:=1;A['V']:=5;A['X']:=10;A['L']:=50;A['C']:=100;
A['D']:=500;A['M']:=1000;
m:=a[so[length(so)]];
For i:= length(so) downto 2 do
If a[so[i]]>a[so[i-1]] then m:=m-a[so[i-1]]
else m:=m+a[so[i-1]];
Writeln(m);
Readln;
End.
Bài 2: Nhập vào một số nguyên (N<4000). Hãy chuyển số đó sang số la mã
Program so_la_ma;
Var a:Array[1..13] of
string=(‘M’,’CM’,’D’,’CD’,’C’,’XC’,’L’,’XL’,’X’,’IX’,’V’,’IV’,’I’);
i,n,m:Longint;
b:Array[1..13] of Longint=(1000,900,500,400,100,90,50,40,10,9,5,4,1);
Begin
Write(‘Nhap so mot so n=’);Readln(n);
i:=1;
While n>0 do
Begin

While n>=b[i] do
Begin
Write(a[i]);
n:=n-b[i];
End;
i:=i+1;
End;
Readln;
End.
CHUYÊN ĐỀ DÃY CON
Bài 1: Dãy con đơn điệu tăng dài nhất
Bài 2: Dãy con đan dấu dài nhất
Bài 3: Dãy con cùng dấu dài nhất
Bài 4: Dãy con có các phần tử kề nhau và giống nhau dài nhất
Bài 5: Dãy con có tổng bằng S
Bài 6: Dãy con có tổng lớn nhất
Bài 7: Dãy con k phần tử có tổng lớn nhất
Bài 8: Dãy con dài nhất có tổng chia hết cho K
Bài 9:Trò chơi với băng số
Trang 4


( Lưu ý nếu có bao nhiêu dãy con thỏa điều kiện thì in ra tất cả !)
Bài 10: Dãy con chung dài nhất của hai dãy
THUẬT TOÁN
Bước 1: Viết chương trình con kiểm tra điều kiện, hoặc chương trình con tính tổng
Bước 2: Viết thủ tục in dãy kết quả
Bước 3: Duyệt mảng để tìm max ( dài nhất hay tổng lớn nhất)
Bước 4: Duyệt mảng lại một lần nữa để truy vết và in kết quả
Ví dụ Bài 1: Dãy con đơn điệu tăng dài nhất

program xd_ctc_day_con;
uses crt;
type mang=array[1..100] of longint;
var a:mang;
i,j,n,dau,max,vt,d:longint;
//-----------Chuong trinh con kiem tra tinh don dieu tang----Function ddt(x,y:Longint):Boolean;
Var i:Longint;
Begin
ddt:=True;
For i:= x to y-1 do
If a[i]>=a[i+1] then ddt:=False;
End;
//-----------------------thu tuc in day con ket qua--------------Procedure inkq(x,y:Longint);
Var i:Longint;
Begin
For i:=x to y do Write(a[i],' ');
Writeln;
End;
//----------------------than chuong trinh--------------------begin
clrscr;
write('nhap so phan tu=');readln(n);
for i:=1 to n do
begin
write('a[',i,']=');readln(a[i]);
end;
//--------------------Thuat toan tim max---------------------Max:=1;
For i:=1 to n-1 do
For j:=i+1 to n do
If ddt(i,j) then
If (j-i+1)>max then max:=j-i+1;

//----------------------Truy vet de in ket qua-------For i:=1 to n-1 do
For j:=i+1 to n do
If ddt(i,j) then
If (j-i+1)=max then inkq(i,j);
readln;
end.
Bài 2,3,4: Chỉ thay thế chương trình con kiểm tra điều kiện
Bài 5: Dãy con có tổng bằng S
program TongbangS;
uses crt;
type mang=array[1..100] of longint;
var a:mang;
Trang 5


i,j,n,dau,max,vt,d:longint;
//-----------Chuong trinh con tính tổng từ x đến y--------Function Tong(x,y:Longint):Longint;
Var i:Longint;
Begin
Tong:=0;
For i:= x to y do Tong:=tong+a[i];
End;
//-----------------------Thu tuc in day con ket qua--------------Procedure inkq(x,y:Longint);
Var i:Longint;
Begin
For i:=x to y do Write(a[i],' ');
Writeln;
End;
//----------------------Than chuong trinh--------------------begin
clrscr;

write('nhap so phan tu=');readln(n);
for i:=1 to n do
begin
write('a[',i,']=');readln(a[i]);
end;
//--------------------Thuat toan---------------------For i:=1 to n-1 do
For j:=i+1 to n do
If Tong(i,j)=S then inkq(i,j);
readln;
End.
Bài 6: Dãy con có tổng lớn nhất:
program DC_Tong_Max;
uses crt;
type mang=array[1..100] of longint;
var a:mang;
i,j,n,dau,max,vt,d:longint;
//-----------Chuong trinh con tính tổng từ x đến y--------Function Tong(x,y:Longint):Longint;
Var i:Longint;
Begin
Tong:=0;
For i:= x to y do Tong:=tong+a[i];
End;
//-----------------------Thu tuc in day con ket qua--------------Procedure inkq(x,y:Longint);
Var i:Longint;
Begin
For i:=x to y do Write(a[i],' ');
Writeln;
End;
//----------------------Than chuong trinh--------------------begin
clrscr;

write('nhap so phan tu=');readln(n);
for i:=1 to n do
begin
Trang 6


write('a[',i,']=');readln(a[i]);
end;
//--------------------------Thuat toan tìm max--------------------Max:=-maxlongint;
For i:=1 to n-1 do
For j:=i+1 to n do
If Tong(i,j)>max then max:=Tong(I,j);
//----------------------Truy vet de in ket qua-------For i:=1 to n-1 do
For j:=i+1 to n do
If Tong(i,j) =max then inkq(i,j);
Readln;
End.
Bài 7: Dãy con K phần tử có tổng lớn nhất
program DC_Tong_Max_K_pt;
uses crt;
type mang=array[1..100] of longint;
var a:mang;
i,j,n,dau,max,vt,d:longint;
//-----------Chuong trinh con tính tổng từ x đến K phân tử--------Function Tong(x:Longint):Longint;
Var i:Longint;
Begin
Tong:=0;
For i:= x to x+k-1 do Tong:=tong+a[i];
End;
//-----------------------Thu tuc in day con ket qua--------------Procedure inkq(x:Longint);

Var i:Longint;
Begin
For i:=x to x+k-1 do Write(a[i],' ');
Writeln;
End;
//----------------------Than chuong trinh--------------------begin
clrscr;
write('nhap so phan tu=');readln(n);
for i:=1 to n do
begin
write('a[',i,']=');readln(a[i]);
end;
//--------------------------Thuat toan tìm max---------------------Max:=-maxlongint;
For i:=1 to n-1 do
For j:=i+1 to n do
If Tong(i)>max then max:=Tong(i);
//----------------------Truy vet de in ket qua-------For i:=1 to n-1 do
For j:=i+1 to n do
If Tong(i) =max then inkq(i);
Readln;
End.
Bài 8: Dãy con dài nhất có tổng chia hết cho K
Trang 7


Program DC_max_pt_chiahet_k;
var a:array[1..100] of longint;
n,i,j,max,k:longint;
//-------------Kiem tra tong cac pt tu x den y co chia het cho k khong------------Function kt(x,y:longint):boolean;
Var i,t:longint;

begin
t:=0;
For i:=x to y do t:=t+a[i];
If t mod k=0 then kt:=True Else kt:=False;
End;
//---------------------------------------------------------------------------------------Procedure inkq(x,y:Longint);
Var i:Longint;
Begin
For i:=x to y do Write(a[i],' ');
Writeln;
End;
Begin
Write('Nhap n=');readln(n);
For i:=1 to n do
Begin
Write('A[',i,']=');readln(a[i]);
End;
Write('k=');Readln(k);
//-------------------------------Thuat toan tim Max------------------------------max:=1;
For i:=1 to n-1 do
For j:=i+1 to n do
If kt(i,j) then
If (j-i+1)>max then max:=j-i+1;
//--------------------------------Truy vet de in ket qua----------------------------If max<>1 then
Begin
For i:=1 to n-1 do
For j:=i+1 to n do
If kt(i,j) then
If (j-i+1)=max then inkq(i,j);
End

Else Writeln('Khong co day con thoa kieu kien');
Readln;
end.
Bài 9: Trò chơi với băng số: Viết dãy lên băng số, mỗi ô chứa một giá trị của a[i],
hãy chia băng số thành nhiều đoạn nhất có thể sao cho tổng các số trong từng đoạn là
bằng nhau:
Program bangso;
var a:array[1..100] of longint;
i,n,tong:longint;
ok:boolean;
//--------CTC kiểm tra dãy có chia thành k đoạn, mỗi đoạn =TC-------------Function kt(k:longint;tc:longint):boolean;
Var i, d, t:longint;
begin
d:=0;t:=0;
Trang 8


End;
Begin

end.

For i:=1 to n do
Begin
t:=t+a[i];
If t=tc then
Begin
d:=d+1;
t:=0;
End;

End;
If d=k then kt:=true else kt:=false;
//------------------------------------------Write('Nhap n=');readln(n);
Tong:=0;
For i:=1 to n do
Begin
Write('A[',i,']=');readln(a[i]);
Tong:=tong+a[i];
End;
//-------------------------------------------For i:=n downto 1 do
If kt(i,tong div i) then
Begin
Write(i,' doan, moi doan bang ',tong div i);
ok:=true;
Break;
End;
If not(ok) then Write('Khong thuc hien duoc tro choi!');
Readln;

CHUYÊN ĐỀ MẢNG 1 CHIỀU
(Nhập - Sắp xếp – Xóa- Chèn- Tần suất)
Bài 1:Sắp xếp mảng tăng dần, nhập x và chèn vào sao cho mảng vẫn tăng dần
Bài 2: Nhập mảng N phần tử:
a) Hãy sắp xếp các số lớn nhất lên dầu dãy, các số nhỏ nhất cuối dãy, nh ững s ố
còn lại ở giữa
b) Hãy sắp xếp các số chẵn chia hết cho 3 lên đầu dãy, các số lẽ chia h ết cho 3
xuống cuối dãy, những số còn lại ở giữa
c) Hãy sắp xếp lại mảng theo thứ tự số ước của chúng tăng dần. N ếu nhi ều s ố có
cùng số ước thì sắp xếp số nhỏ đứng trước số lớn
d) Hãy xóa đi vị trí thứ k trong mảng ( Sử dụng thủ tục xóa)

e) Hãy chèn X vào vị trí thứ k trong dãy (dùng thủ tục chèn)
f) Tìm kiếm và thay thế: Hãy tìm tất cả các c ặp số c ạnh nhau có t ổng chia h ết cho
10 và thay thế các số này bằng tổng của chúng
g) Nhập dãy tăng, sai thì nhập lại, nhập -1 thì dừng và tính tổng (bỏ -1)
h) Nhập dãy n pt, In ra màn hình các số âm tăng dần, các số d ương gi ảm d ần
i) Đếm số phân tử khác nhau, tần suất xuất hiện của các phần tử
CHUYÊN ĐỀ CHUỖI KÍ TỰ
1. Tuần suất:
a) Tần suất các kí tự là chữ cái khơng phân biệt hoa thường; tần suất các kí t ự
số;
b) Kí tự xuất hiện nhiều nhất và vị trí xuất hiện, số lần xuất hiện
HƯỚNG DẪN GIẢI
a) Tần suất các kí tự là chữ cái khơng phân biệt hoa thường; tần suất các kí t ự
số;
Trang 9


Program Tan_suat_ki_tu_chu_cai;
Var st:String;
A:Array['A'..'Z']of Longint;
i:Longint;
ch:char;
Begin
Write('st=');Readln(st);
For i:=1 to length(st) do
If st[i] in['a'..'z'] then st[i]:=Upcase(st[i]);
//--------------------------------------------------------For ch:='A' to 'Z' do A[ch]:=0;
For i:= 1 to length(st) do
If st[i] in['A'..'Z'] then A[st[i]]:=A[st[i]]+1;
For ch:='A' to 'Z' do

If A[ch]<>0 then Writeln(ch,'----->',A[ch]);
Readln;
End.
Program Tan_suat_ki_tu_so;
Var st:String;
A:Array['0'..'9’]of Longint;
i:Longint;
ch:char;
Begin
Write('st=');Readln(st);
//--------------------------------------------------------For ch:='0' to '9' do A[ch]:=0;
For i:= 1 to length(st) do
If st[i] in['0'..'9'] then A[st[i]]:=A[st[i]]+1;
For ch:='0' to '9' do
If A[ch]<>0 then Writeln(ch,'----->',A[ch]);
Readln;
End.
2. Nhập chuỗi gồm nhiều từ: chuẩn hóa chuổi; đếm số từ, in từ dài nhất; in từ đối

xứng trong chuỗi; in câu đảo có nghĩa;
3. Chuỗi con:
a) Chuỗi con đối xứng dài nhất;
b) Chuỗi con gồm các phần tử kề nhau và giống nhau dài nhất;
c) Kiểm tra chuỗi có k phần tử kề nhau và giống nhay khơng, nếu có xóa các pt
kề và giống nhau chỉ giữ lại 1 kí tự
d) Chuỗi con chung dài nhất của hai chuỗi;
e) Kiểm tra hai chuỗi có phải là hai chuỗi bạn bè hay không
f) Nén và giải nén chuỗi
HƯỚNG DẪN GIẢI
(Tương tự như dãy con trong mảng 1 chiều)

a) Chuỗi con đối xứng dài nhất:
- Bước 1: Chương trình con kiểm tra tính đối xứng từ vị trí x đến y
- Bước 2: Thủ tục in từ vị trí x đến vị trí y chuỗi st
- Bước 3: Duyệt chuỗi tìm max ( dài nhất)
- Bước 4: Duyệt chuỗi truy vết để in kết quả
Program Chuoi_con_dx_max;
Var st:String;
i,j,max:Longint;
//-------------------------------------------------------------------------------Function dx(x,y:Longint):Boolean;
Var i:Longint;

Trang 10


Begin
dx:=True;
For i:= x to y do
If st[i]<>st[y-i+x] then
Begin
dx:=False;Break;
End;
End;
//-------------------------------------------------------------------------------Procedure inkq(x,y:Longint);
Var i:Longint;
Begin
For i:=x to y do Write(st[i]);
Writeln;
End;
//-------------------------------------------------------------------------------Begin
Write('st=');Readln(st);

max:=1;
For i:=1 to length(st)-1 do
For j:=i+1 to length(st) do
If dx(i,j) then
If(j-i+1)>max then max:=j-i+1;
//-------------Truy vet va in ket qua----------------------For i:=1 to length(st)-1 do
For j:=i+1 to length(st) do
If dx(i,j) then
If(j-i+1)=max then inkq(i,j);
Readln;
End.
b) Chuỗi con có các phần tử kề và giống nhau dài nhất
Program Mat_bang_chuoi;
Var st:String;
i,j,max:Longint;
//----------------CTC kiem tra tu x den y co ging nhau khong--------Function kt(x,y:Longint):Boolean;
Var i: Longint;
Begin
Kt:=True;
For i:= x to y -1 do
If st[i]<>st[i+1] then kt:=False;
End;
//-------------------------------------------------------------------------------Procedure inkq(x,y:Longint);
Var i:Longint;
Begin
For i:=x to y do Write(st[i]);
Writeln;
End;
//-----------------------------Thuat toán tim Max--------------------------Begin
Write('st=');Readln(st);

max:=1;
For i:=1 to length(st)-1 do
For j:=i+1 to length(st) do
If kt(i,j) then
If(j-i+1)>max then max:=j-i+1;
Trang 11


//-----------------------Truy vet va in ket qua----------------------For i:=1 to length(st)-1 do
For j:=i+1 to length(st) do
If kt(i,j) then
If(j-i+1)=max then inkq(i,j);
Readln;
End.
c) Kiểm tra chuỗi có K kí tự kề và giống nhau hay khơng, nếu có hãy xóa các kí tự
kề và giống nhau chỉ giữ lại 1 kí tự
Program Chuoi_con_k;
Var st:String;
i,j,k:Longint;
ok:Boolean;
//-----------------------------------------------------Function kt(x:Longint):Boolean;
Var i:Longint;
Begin
kt:=True;
For i:= x to x+k-1-1 do
If st[i]<>st[i+1] then
Begin
kt:=False;Break;
End;
End;

//-----------------------------------------------------Begin
Write('st=');Readln(st);
Write('k=');Readln(k);
For i:=1 to length(st)-1 do
For j:=i+1 to length(st) do
If kt(i) then
Begin
ok:=True;Break;
End;
If ok then Writeln('Yes') Else Writeln('No');
//------------------------------------------------------i:=1;
While iIf st[i]=st[i+1] then delete(st,i,1) Else i:=i+1;
Write(st);
Readln;
End.
d) Chuỗi con chung dài nhất của hai chuỗi
Program Chuoi_con_chung_max;
Var st1,st2:String;
i,j,max:Longint;
//----------------------------CTC dem-----------------------------------Function dem(x,y:Longint):Longint;
Var i,d:Longint;
Begin
d:=0;
While (st1[x]=st2[y])and (x<=length(st1))and(y<=length(st2)) do
Begin
d:=d+1;x:=x+1;y:=y+1;
Trang 12

End;
dem:=d;
End;
//-----------------Thu tuc in chuoi con ket qua-----------------Procedure inkq(x:Longint);
Var i:Longint;
Begin
For i:=x to x+max-1 do Write(st1[i]);
Writeln;
End;
//---------------------------------------------------------------Begin
Write('st1=');Readln(st1);
Write('st2=');Readln(st2);
//---------------------- Tim max--------------------------------max:=0;
For i:=1 to length(st1) do
For j:=1 to length(st2) do
If dem(i,j)>max then max:=dem(i,j);
//----------------Truy vet in ket qua----------------------------For i:=1 to length(st1) do
For j:=1 to length(st2) do
If dem(i,j)=max then inkq(i);
Readln;
End.
e) Chuỗi bạn bè
Program chuoibanbe;
uses crt;
var st1,st2:string;
Function banbe(st1:string;st2:string):boolean;
var i,j,d:longint;
Begin
d:=0;
For i:=1 to length(st1) do

For j:=1 to length(st2) do
If st1[i]=st2[j] then
Begin
d:=d+1;
break;
End;
If d=length(st1) Then banbe:=true Else Banbe:=false;
End;
Begin
Write('chuoi 1:');readln(st1);
Write('Chuoi 2:');readln(st2);
If banbe(st1,st2) and banbe(st2,st1) then Write('Dung') else Write('sai');
Readln;
end.
***
F ) Nén và giải nén chuỗi
Để tiết kiệm không gian bộ nhớ người ta nén chuỗi theo quy tắc: Nếu có từ 3 kí tự
liên tiếp trùng nhau trở lên thì nén thành m ột con s ố và 1 kí tự
u cầu: viết chương trình thực hiện công việc sau:
Trang 13


a/ Nhập chuỗi S1 từ bàn phím, nén chuỗi s1 thành chuỗi S2 và xuất S2 ra màn hinh
VD: S1: AABCAAAAACCCCBBB ->S2: AABC5A4C3B
b/ Từ bàn phím nhập chuỗi S2 dưới dạng đã nén, giải nén lại chuỗi S1 ban đầu, xuất kết
quả ra màn hình
VD: S2: AABC5A4C3B ->S1: AABCAAAAACCCCBBB
Program nen_giainen;
Var st1,st2:String;
i,j:Longint;

Function dem(x:Longint):Longint;
Var i,d:Longint;
Begin
d:=1;
For i:= x to length(st1)-1 do
If st1[i]=st1[i+1] then d:=d+1 Else Break;
dem:=d;
End;
Procedure nen(st:String);
Var i:Longint;
Begin
i:=1;
While i<=length(st) do
Begin
If dem(i)=1 then Write(st[i]) Else
If dem(i)=2 then Write(st[i],st[i]) Else
If dem(i)>2 then Write(dem(i),st[i+1]);
i:=i+dem(i);
End;
Writeln;
End;
Procedure giainen(st:String);
Var i,x,y,z,code:Longint;
Begin
For i:=1 to length(st) do
Begin
If Not(st[i] in['0'..'9']) then Write(st[i]);
If (st[i] in['3'..'9'])and (Not(st[i+1] in['0'..'9'])) then
Begin
val(st[i],x,code);

For j:=1 to x-1 do Write(st[i+1]);
End;
If (st[i] in['1'..'9'])and (st[i+1] in['0'..'9']) then
Begin
val(st[i],x,code);
z:=10*x;
For j:=1 to z do Write(st[i+2]);
End;
End;
End;
Begin
Write('nhap chuoi can nen=');Readln(st1);
Writeln('Chuoi sau khi nen la: ');nen(st1);
Write('Nhap chuoi can giai nen:');Readln(st2);
Writeln('Chuoi sau khi giai nen la: ');giainen(st2);
Trang 14


Readln;
End.
4. Mã hóa chuối: Mã hóa ceaser; Mã hóa đối xứng
97

65

96

66

95

67

...

68

...

69

...

70
74

71
73

72

Z

A

Y

B

X

C

....

D

....

E

....

F

N

G

M

H
L

J
K

I

program ceaser;

uses crt;
var st,st1:string;
k:longint;
Procedure mahoa(st:string);
Var i:longint;
Begin
For i:=1 to length(st) do
If st[i]<>' ' then st[i]:=char(((ord(st[i])-65+k)mod 26)+65);
Write('Chuoi sau khi ma hoa la: ',st);
End;
Procedure giaima(st:string);
Var i:longint;
Begin
For i:=1 to length(st) do st[i]:=char((((ord(st[i])-65-k)+26)mod 26)+65);
Write('Chuoi sau khi giai ma la: ',st);
End;
Begin
Write('Nhap chuoi:');readln(st);
Trang 15


WRite('Nhap k:');readln(k);
mahoa(st);
Writeln;
Write('chuoi2:');readln(st1);giaima(st1);
Readln;
end.
CHUYÊN ĐỀ SỐ HỌC
I. Các loại số cơ bản:
1. Số nguyên tố

2. Số hoàn chỉnh
3. Cặp số nguyên tố tương đương.
4. Số may mắn
5. Số phản nguyên tố
6. Số song nguyên tố
7. Cặp số hữu nghị
8. Số Fi-Bô-Na-Xi thứ N
9. Độ bền của một số
10. Chuyển chữ số lớn nhất ra đầu số
11. Rút gọn phân số
12. Tìm số chữ số 0 tận cùng của N!
13. Số thú vị :là số nguyên tố và đảo ngược của nó cũng là số nguyên tố
14. Số song đối xứng là số đối xứng và biểu diễn nhị phân của nó cũng là một số
đối xứng. Tìm các số song đối xứng nhỏ hơn N
15. Tìm số nguyên tố ghép thứ k
16. Số siêu nguyên tố có N chữ số
HƯỚNG DẪN GIẢI (Một số bài khó)
Bài 3: Cặp số gọi là cặp số nguyên tố tương đương nếu chúng có cùng ước nguyên
tố. Nhập n,m kiểm tra n,m có phải là cặp số nguyên tố tương đường hay không ?
Program nttd_2;
Var C,D:Array[1..100] of longint;
a,b,m,n,i,max,min,so1,so2:Longint;
ok1,ok2,ok:Boolean;
Begin
Write('a=');Readln(a);
Write('b=');Readln(b);
//------------------------Tim max, min-----------------------------If a>b then
Begin
max:=a;min:=b;
End Else

Begin
max:=b;min:=a;
End;
so1:=max;so2:=min;
//-----------------------Phan tich Max thanh thua so nguyen to-----i:=2;n:=0;
While max>1 do
Begin
If max mod i=0 then
Begin
n:=n+1;
C[n]:=i;
max:=max div i;
Trang 16


End Else i:=i+1;
End;
//-----------------------Phan tich Min thanh thua so nguyen to-----i:=2;m:=0;
While min>1 do
Begin
If min mod i=0 then
Begin
m:=m+1;
d[m]:=i;
min:=min div i;
End Else i:=i+1;
End;
//---------------------Kiem tra hai so co phai la nttd khong-------ok1:=True;ok2:=True;
For i:=1 to n do
If ( so2 mod c[i]<>0) then ok1:=False;

For i:=1 to m do
If ( so1 mod d[i]<>0) then ok2:=False;
If ok1 and ok2 then ok:=True Else ok:=False;
If ok then Writeln('NTTD') Else Writeln('Khong !');
Readln;
End.
Bài 4: Số may mắn là số chia thành hai nửa có tổng các chữ số của nửa này bằng tổng
các chữ số của nửa kia. Tìm số may mắn nhỏ nhất lớn hơn N
Program mayman;
Uses Crt;
Var n,i,a,b,d:Longint;
st:String;
Function tong(n:Longint):Integer;
Begin
If n<10 then tong:=n Else tong:=n mod 10+tong(n div 10);
End;
Function smm(n:Longint):Boolean;
Var a,b,i:Longint;
st:String;
Begin
smm:=False;
str(n,st);
For i:= 1 to length(st) do
Begin
a:=n mod trunc(exp(ln(10)*i));
b:=n div trunc(exp(ln(10)*i));
If tong(a)=tong(b) then
Begin
smm:=True; Break;
End;

End;
End;
Begin
Write('Nhap n=');Readln(n);
For i:=1 to n do
If smm(i) then Write(i,' ;');
Readln;
End.
Bài 5: Số phản nguyên tố là số có nhiều ước nhất trong các số từ 1 đến (nó-1)
Trang 17


Ví dụ: 6 là phản ngun tố vì 6 có 4 ước, các số từ 1 đến 5 khơng có số nào nhi ều hơn 4
ước
Program phan_nguyen_to;
Var n,i:Longint;
Function dem(n:Longint):Longint;
Var d,i:Longint;
Begin
d:=0;
For i:=1 to n do
If n mod i=0 then d:=d+1;
dem:=d;
End;
Function pnt(n:Longint):Boolean;
Var i:Longint;
Begin
pnt:=True;
For i:=1 to n do
If dem(i)>dem(n) then

Begin
pnt:=False;Break;
End;
End;
Begin
Write('n=');Readln(n);
For i:=1 to n do
If pnt(i) then Write(i,' ');
Readln;
End.
Bài 6: Số song nguyên tố là một số nguyên tố và tổng các chữ số của nó cũng là một số
nguyên tố
Bài 7: Cặp số hữu nghị là tổng các ước của số này bằng số kia và ngược lại. Tìm cắp số
hữu nghị nhỏ hơn N
Program so_huu_nghi;
Var i,n:longint;
Function TU(n:Longint):Longint;
Var t,i:Longint;
Begin
t:=0;
For i:=1 to n-1 do
If (n mod i=0) then t:=t+i;
TU:=t;
End;
Begin
Write('n=');Readln(n);
For i:=1 to n do
If (TU(TU(i))=i)and(i<=TU(i)) then Writeln(i,' & ',TU(i));
Readln;
End.

Bài 8: F1:=1;F2:=1;Fn:=F(n-1)+F(n-2);
Bài 9: Nếu N<10 thì độ bền =0 ngược lại độ bền của N:=1+độ bền của tích các chữ số
của N
Program do_ben_3;
Var n,max,k:int64;
i:Longint;
Function tich(n:int64):Longint;
Trang 18


Begin
If n<10 then tich:=n Else tich:=(n mod 10)*tich(n div 10);
End;
Function db(n:int64):Integer;
Begin
If n<10 then db:=0 Else db:=db(tich(n))+1;
End;
Begin
Write('n=');Readln(n);
max:=0;k:=0;
For i:=n div 10 to n do
If db(i)>max then
Begin
max:=db(i);k:=i;
End;
Writeln(k,'-------->',max);
End.
Bài 10: Chuyển chữ số lớn nhất ra đầu
Program chuyenvitri;
Var n:Longint;

st:String;
max:char;
i,m,vt:Longint;
Begin
Write('n=');Readln(n);
str(n,st);
m:=length(st);
max:='0';vt:=1;
FOr i:=1 to m do
If st[i]>max then
Begin
max:=st[i];
vt:=i;
End;
Delete(st,vt,1);
st:=max+st;
Writeln(st);
Readln;
End.
Bài 11: Rút gọn phân số a/b
Program rut_gon_phan_so;
Var a,b:Longint;
dau:String;
Function ucln(a,b:Longint):Longint;
Begin
If a mod b=0 then ucln:=b Else ucln:=ucln(b,a mod b);
End;
Begin
Write('a=');Readln(a);
Repeat

Write('b=');Readln(b);
If b=0 then Writeln('Nhap sai, xin nhap lai !');
Until b<>0;
If (a*b)>=0 then dau:='' Else dau:='-';
a:=abs(a); b:=abs(b);
Trang 19


If a mod b=0 then Writeln('PS khi rut gon la: ',dau,a div b) Else
Writeln('PS khi rut gon la:',dau,a div ucln(a,b),'/',b div ucln(a,b));
Readln;
End.
Bài 12: Nếu N<5 thì số chữ số 0 tận cùng bằng 0, ngược lại thì số chữ số không tận cùng
bằng: (n div 5)+ Số chữ số 0 tân cùng của (n div 5)
Program so_0_tan_cung;
Var n:Integer;
Function dem(n:Longint):Longint;
Begin
If n<5 then dem:=0 Else dem:=(n div 5)+dem(n div 5);
End;
Begin
Write('n=');Readln(n);
Write(dem(n));
Readln;
End.
Bài 13: Số thú vị là số nguyên tố và đảo ngược của nó cũng là số nguyên tố
Bài 14: Số song đối xứng là số đối xứng và biểu diễn nhị phân của nó cũng là số đối
xứng
Program song_doi_xung;
Var n,i:Longint;

chuoi:String;
Function dx(st:String):Boolean;
Var i:Longint;
Begin
dx:=True;
For i:=1 to length(st) div 2 do
If st[i]<>st[length(st)-i+1] then dx:=False;
End;
Function np(n:Longint):String;
Var kq,x:String;
Begin
kq:='';x:='';
While n>0 do
Begin
str(n mod 2,x);
kq:=kq+x;
n:=n div 2;
End;
np:=kq;
End;
Begin
Write('n=');Readln(n);
For i:=1 to n do
Begin
str(i,chuoi);
If dx(chuoi) and dx(np(i)) then Write(i,' ');
End;
Readln;
End.
Bài 15: TÌm số nguyên tố ghép thứ K

Program nguyento_ghep;
Trang 20


Uses Crt;
Var k:Word;
n,i,d:Longint;
a:Array[1..100000] of Longint;
Function ghep(m,n:Longint):Longint;
Var a,b,c:String;
code:Integer;
x:Longint;
Begin
str(m,a);str(n,b);c:=a+b;
Val(c,x,code);
ghep:=x;
End;
Function kt(n:Longint):Boolean;
Var i:Longint;
Begin
kt:=True;
If n<2 then kt:=false Else
For i:=2 to trunc(sqrt(n)) do
If n mod i=0 then
Begin
kt:=False; Break;
End;
End;
Begin
n:=0;

For i:=2 to 10000 do
If kt(i) then
Begin
n:=n+1;
a[n]:=i;
End;
Write('Nhap so nguyen to ghep thu can tim:');Readln(k);
i:=1; d:=0;
While i<(n-1) do
Begin
If kt(ghep(a[i],a[i+1]))then d:=d+1;
If d=k then
Begin
Writeln('-------->',ghep(a[i],a[i+1]));
Break;
End;
i:=i+2;
End;
Readln;
End.
Bài 16: Số siêu nguyên tố có N chữ số
Program sieunguyentonchuso;
Uses crt;
var a:array[1..4] of Byte=(2,3,5,7);
b:array[1..4] of byte=(1,3,7,9);
n,i,d:longint;
Function kt(n:longint):boolean;
var i:longint;
begin
If n<2 then kt:=false else

Trang 21


For i:=2 to trunc(sqrt(n)) do
If (n mod i=0) then
Begin
kt:=false;
exit;
End;
End;
Procedure try(j:int64);
var i:longint;
a:string;
begin
str(j,a);
If length(a)=n then
Begin
Write(j,' ');
d:=d+1;
End else
For i:=1 to 4 do
If kt(j*10+b[i]) then try(j*10+b[i]);
End;
Begin
Write('nhap so chu so sieu nguyen to: ');readln(n);
For i:=1 to 4 do try(a[i]);Writeln;
Write('Co ',d,' so sieu nguyen to');
Readln;
End.
CHUYÊN ĐỀ PHÂN TÍCH SỐ

1) Phân tích một số thành tổng
a) Phân tích một số thành tổng của hai số nguyên tố
b) Phân tích một số thành tổng của ba số nguyên tố
c) Phân tích một số thành tổng của các số tự nhiên liên tiếp
d) Phân tích một số thành tổng của các số FBNX đơi một khác nhau
2) Phân tích một số thành tích
a) Phân tích một số thành tích các thừa số nguyên tố dạng nhân
b) Phân tích một số thành tích các thừa số nguyên tố dạng lũy thừa
c) Tìm số nhỏ hơn N sao cho khi phân tích ra thừa số ngun tố có nhi ều nhân tử
nhất
HƯỚNG DẪN
1) Dạng tốn phân tích thành tổng
b) Phân tích một số thành tổng của ba số nguyên tố
Program PhantichN_tong_3SNT;
Var n,i,j:Longint;
Function kt(n:Longint):Boolean;
Var i:Longint;
Begin
kt:=True;
If n<2 then kt:=False Else
For i:=2 to trunc(sqrt(n)) do
If n mod i=0 then
Begin
kt:=False; Break;
End;
End;
Begin
Write('n=');Readln(n);
Trang 22

If n<6 then Writeln('Khong the phan tich') Else
For i:=1 to n div 3 do
If kt(i) then
For j:=i to (n-i) div 2 do
If kt(j) and kt(n-i-j) then Writeln(n,'=',i,'+',j,'+',n-i-j);
Readln;
End.
c) Phân tích N thành tổng các số tự nhiên liên tiếp
Program PT_N_tong;
Var n,i,j:Longint;
ok:Boolean;
Function tong(x,y:Longint):Longint;
Var i,t:Longint;
Begin
t:=0;
For i:=x to y do t:=t+i;
tong:=t;
End;
Procedure inkq(x,y:Longint);
Var i:Longint;
Begin
Write(n,'=');
For i:= x to y-1 do Write(i,'+');
Writeln(y);
End;
Begin
Write('n=');Readln(n);
ok:=True;
For i:=1 to n-1 do

For j:=i+1 to n do
If tong(i,j)=n then
Begin
inkq(i,j);
ok:=False;
End;
If ok then Writeln('Khong the phan tich');
Readln;
End.
d)Phân tích N thành tổng các số Fi-Bo-Na-Xi đơi một khác nhau
Program PT_n_FBNX;
Var n:Int64;
i:Longint;
A:Array[1..100] of Int64;
Begin
Write('n=');Readln(n);
a[1]:=1; a[2]:=1;
For i:=3 to 60 do a[i]:=a[i-1]+a[i-2];
For i:= 60 downto 1 do
If n>=a[i] then
Begin
Write(a[i]);
n:=n-a[i];
If n>0 then Write('+') Else Writeln('.');
End;
Readln;
Trang 23


End.

2) Dạng tốn phân tích N thành tích
a) Phân tích N thành tích các thừa số nguyên tố dạng nhân
Program pt_N_TSNT;
Uses crt;
Var n,i,m:longint;
A:Array[1..100] of Longint;
//--------------------------------------------------------------------------------Begin
Write('n=');Readln(n);
i:=2;m:=0;
While n>1 do
If n mod i=0 then
Begin
m:=m+1;
a[m]:=i;
n:=n div i;
End Else i:=i+1;
//--------------------------------In m ảng k ết qu ả----------------------------For i:=1 to m-1 do Write(a[i],’*’)’
Writeln(‘.’);
Readln;
end.

b) Phân tích N thành tích các thừa số nguyên tố dạng lũy thừa
Program pt_N_luy_thua;
Uses crt;
Var n,i,m:longint;
A:Array[1..100] of Longint;
B:Array[1..100] of Boolean;
//-----------CTC đếm trong A[m] có bao nhiêu phần tử=a[x]----------------Function dem(x:longint):Longint;
Var d:integer;
Begin

d:=0;
For i:=1 to m do If x=a[i] then d:=d+1;
dem:=d;
End;
//----------------Đưa các ước nguyên tố của N vào A[m] --------------------------Begin
Write('n=');Readln(n);
i:=2;m:=0;
While n>1 do
If n mod i=0 then
Begin
m:=m+1;
a[m]:=i;
n:=n div i;
End Else i:=i+1;
//-------------------Đánh dấu các pt giống nhau là False------------------------For i:=1 to m do b[i]:=True;
For i:=1 to m-1 do If (a[i]=a[i+1] ) then b[i+1]:=False;
//----------------------------Duyệt mảng và in kết quả----------------------------For i:=1 to m do
Trang 24


If b[i] then Write(a[i],'^',dem(a[i]),'.');
Readln;
end.

c) Tìm số nhỏ hơn N mà sau khi phân tích ra thừa số ngun tố có nhiều nhân tử
nhất ( Hoặc tìm số nhỏ hơn N mà có nhiều ước nguyên tố nhất)
Bước 1: CTC đếm số ước nguyên tố của một số N
Bước 2: Thủ tục phân tích một số N ra thừa số nguyên tố
Bước 3: Tìm max ( số ước nguyên tố nhiều nhất trong các số từ 1 đến n)
Bước 4: Truy vết và in kết quả ( phân tích)

Program Tim_n_Min;
Uses crt;
Var n,i,max:longint;
//--------------------Đếm số N có bao nhiêu ước nguyên tố-------------------------Function dem(n:longint):Longint;
Var d,i:integer;
Begin
i:=2;d:=0;
While n>1 do
If n mod i=0 then
Begin
d:=d+1;
n:=n div i;
End Else i:=i+1;
dem:=d;
End;
//-------------------Thủ tục phân tích N ra thừa số nguyên tố-------------------Procedure phantich(n:longint);
Var i:integer;
Begin
i:=2;Write(n,'=');
While n>1 do
If n mod i=0 then
Begin
Write(i,'.');
n:=n div i;
End Else i:=i+1;
Writeln;
End;
Begin
Write('n=');Readln(n);
For i:= 1 to n-1 do If dem(i)>max then max:=dem(i);

For i:=1 to n do If dem(i)=max then phantich(i);
Readln;
end.
Nhận xét: Các số nhỏ hơn N có nhiều ước nhất đều có dạng 2x hoặc 2x-1.3
Như vậy bài tốn thành: Tìm x lớn nhất sao cho 2x Bài toán trở nên rất đơn giản !
Var n,d,i,S:Longint;
Begin
Write('n=');Readln(n);
d:=1;S:=2;
While (SBegin
S:=S*2; d:=d+1;
Trang 25