bài tạp cấu trúc vòng lặp

I. CẤU TRÚC VÒNG LẶP
1. Viết chương trình nhập vào một số nguyên rồi in ra màn hình tất cả các ước
số của số đó.
Giải:
Uses Crt;
Var N,i : Integer;
Begin
Clrscr;
Write('Nhap so nguyen N= '); Readln(N);
For i:=1 To N Do
If N MOD i=0 Then
Write(i:5);
Readln;
End.
2. Viết chương trình vẽ một tam giác cân bằng các dấu sao (*)
Giải:
uses crt;
var n,i,j:longint;
begin
write('Chieu cao = ');
readln(n);
clrscr;
for i:=1 to n do
begin
if i<> n then
for j:=1 to n*2-1 do
if (j = n-i+1) OR (j = n+i-1) then write('*') else write(' ')
else
for j:=1 to n*2-1 do
write('*');
writeln;

end;
readln;
end.
3. Viết chương trình tính tổng nghịch đảo của N số nguyên đầu tiên theo công
thức
S = 1 + 1/2 + 1/3 + … + 1/N
GIAÛI
Uses Crt ;
Var i , n : Integer ;
tong: Real ;
BEGIN
Clrscr ;
Write (' Cho so tu nhien n : ') ; Readln (n) ;
tong :=0 ;
i :=1 ;
While i <= n Do
1


Begin
tong := tong + 1/i ;
i := i + 1 ;
End ;
Writeln (' Tong can tim la : ', tong:12:6 ) ;
Readln ; END .
4. Viết chương trình tính tổng bình phương các số lẻ từ 1 đến N.
Uses Crt ;
Var s,i,n:integer;
tiep:char;
begin

Clrscr ;
repeat
writeln('=================');
writeln('CT TINH TONG BP');
writeln('=================');
writeln('Nhap n');
readln(n);
i:=1;
s:=0;
while i<(2*n-1)
do
begin
i:=i+2;
s:=s+i*I;
end;
writeln('KQ',s:10);
writeln('===============');
writeln('Thuc hien nua khong(c/k)?');
readln(tiep);
until upcase(tiep)='K';
end.
5. Viết chương trình nhập vào N số nguyên, tìm số lớn nhất trong các số đó.
Giải:
Program So_lon_so_nho;
Uses Crt ;
Var
so1,so2,so3,so4,max,min:Integer;
Begin
clrscr;
Writeln('TIM SO LON NHAT VA SO NHO NHAT');

Writeln('-----------------------------');
Write('-Nhap so thu nhat: ');
Readln(so1);
Write('-Nhap so thu hai : ');
Readln(so2);
2


Write('-Nhap so thu ba : ');
Readln(so3);
Write('-Nhap so thu tu : ');
Readln(so4);
max:=so1;
min:=so1;
If max < so2 Then
max:=so2
Else
min:=so2;
If max < so3 Then
max:=so3
Else
min:=so3;
If max < so4 Then
max:=so4;
Writeln;
Writeln('+So lon nhat trong 4 so: ',so1,',',so2,',',
so3,',',so4,' la: ',max);
Writeln('+Va so nho nhat trong 4 so do la
: ',
min);

Writeln;
Writeln('
Bam phim <Enter> de ket thuc');
Readln
End.
6. Viết chương trình tính giai thừa của N với N nhập từ bàn phím.
Giải:
uses crt;
var i,n,gt:longint;
begin
clrscr;
write('n=');readln(n);
gt:=1;
for i:=1 to n do
gt:=gt*i;
write(n,'!=',gt);
readln;
end.
7. Viết chương trình nhập vào 1 số và kiểm tra số đó có phải là số nguyên tố
hay không?
Giải.
uses crt;
clrscr;
VAR i,n :INTEGER;
BEGIN
Write ('Nhap n:');
Readln(n);
3

Write (n,'=');
i:=2;
REPEAT
WHILE n MOD i <> 0 DO
i:=i+1;
Write(i);
n:=n DIV i;
IF n > 1 THEN
write ('*');
UNTIL n = 1;
readln;
END.
8. Viết chương trình tính số hạng thứ n của dãy Fibonaci. Dãy Fibonaci là dãy
số gồm các số hạng p(n) với p(n) = p(n-1) + p(n-2) với n>2 và p(1) = p(2) = 1
Giải:
uses crt;
var i,n,f1,f2: integer;
begin
clrscr;
write('Nhap n: ');
readln(n);
f1:=1;
f2:=1;
for i:=1 to n do
begin
write(f1,' ');
f2:=f2+f1;
f1:=f2-f1;
end;
readln;

end.
9. Viết chương trình tính Xn với n nhập vào từ bàn phím.
GIAÛI
Uses Crt ;
Var i , n : Integer ;
a , giatri : Real ;
BEGIN
Clrscr ;
Write (' Cho so a : ') ; Readln(a) ;
Write (' Cho so mu n : ') ; Readln(n) ;
i := 1 ;
giatri := 1 ;
While i <= n Do
Begin
giatri := giatri * a ;
i:= i+1 ;
4


End ;
Writeln(' a mu n bang : ', giatri ) ;
Readln ; END .
10. Viết chương trình phân tích một số nguyên N thành tích các thừa số
nguyên tố.
Giải:
VAR i,n :INTEGER;
BEGIN
Write ('Nhap n:');
Readln(n);
Write (n,'=');

i:=2;
REPEAT
WHILE n MOD i <> 0 DO
i:=i+1;
Write(i);
n:=n DIV i;
IF n > 1 THEN
write ('*');
UNTIL n = 1;
readln;
END.
11. Viết chương trình giải phương trình bậc 2
aX2 + bX + C = 0
Sử dụng câu lệnh lặp Repeat…Until để bắt buộc nhập hệ số a<>0
Giải:
PROGRAM ptb2;
USES crt;
VAR a,b,c,x1,x2,d:REAL;
BEGIN
clrscr;
REPEAT
write('Nhap cac he so a, b, c: ');
readln(a,b,c);
UNTIL a<>0;
d:=sqr(b)-4*a*c;
IF d<0 THEN write('Phuong trinh vo nghiem!')
ELSE
BEGIN
x1:=(-b-sqrt(d))/(2*a);
x2:=(-b+sqrt(d))/(2*a);

IF d=0 THEN writeln('Phuong trinh co nghiem
kep x = ',x1:5:1)
5


ELSE writeln('Phuong trinh co 2 nghiem phan
biet: ',x1:5:1,x2:5:1);
END;
readln;
END.
12. Viết chương trình đổi một số nguyên hệ 10 sang hệ 2 và hệ 16
13. Viết chương trình tìm UCLN và BCNN của 2 số nguyên nhập vào từ bàn
phím.
Giải:
Uses crt;
Var a,b,aa,bb:integer;
Begin
Write('Nhap a : '); Readln(a);
Write('Nhap b : '); Readln(b);
aa:=a; bb:=b;
While aa<>bb Do
Begin
If aa>bb Then aa:=aa-bb Else
bb:=bb-aa;
End;
Writeln('USCLN= ',aa);
Writeln('BSCNN= ',a*b DIV aa);
Readln;
End.
14. Viết chương trình giải bài toán cổ sau

a)
Trăm trâu, trăm cỏ
Trâu đứng ăn năm
Trâu nằm ăn ba
Ba trâu già ăn một
Hỏi mỗi loại trâu có bao nhiêu con?
Giải:
Program tramtrautramco;
uses crt;
var x, y, z: integer ;
begin
clrscr ;
writeln('Bai toan tram trau tram co') ;
for x:=1 to 20 do
for y:= 1to 33 do
Begin
z:=100-x-y;
If ((5*x + 3*y + z/3) = 100) then writeln('Trau dung: ', x:3 ,' trau nam: ', y:3 ,' trau
gia: ', z:3) ;
End ;
6


Readln
End.
b)

Vừa gà vừa chó 36 con
Bó lại cho tròn 100 chân chẵn
Hỏi có bao nhiêu gà, chó

Giải:
uses crt;
var g,c: integer;
begin
clrscr;
for c:=1 to 25 do
begin
g:=36-c;
if 4*c+2*g=100 then
write('So ga: ',g,' So cho: ',c);
end;
readln;
end.
15. Viết chương trình nhập vào một số N, hãy tìm các số nguyên tố từ 2 đến N.
Giải:
Uses crt;
var i,dem,j,n:Integer;
Begin
Clrscr;
write('Nhap so nguyen n');ReadLn(n);
if n>0 Then
begin
WriteLn('Cac so nguyen to tu 2 den ',n,' la:');
for j:=2 to n Do
begin
dem:=0;
for i:= 1 to j do if j mod i=0 then dem:=dem+1;
if dem=2 then write(j,' ');
end;
end;

Readln
End.
II. CHƯƠNG TRÌNH CON
1. Viết hàm tính tổng các số chẵn từ M đến N
uses crt;
var i,n,s:integer;
begin
clrscr;
7


writeln(' Nhap n : ' );Readln(n);
S:=0;
For i:=1 to n do
begin
if (i mod 2) = 0 then s:=s+i;
end;
Writeln('Tong S: ,S’);readln;
END.
2. Viết chương trình con tìm USCLN của 2 số x và y
var x,y,UCLN,BCNN:integer;
begin
readln(x,y);
BCNN:=x*y;
While x<>y do If x>y then x:=x-y else y:=y-x;
UCLN:=x;
BCNN:=BCNN div UCLN;
write(UCLN,' ',BCNN);
end.

3. Tạo dãy số Fibonaci
Dãy số Fibonaci là dãy số gồm các số hạng p(n) với p(n) = p(n-1) + p(n-2)
với n>2 và p(1) = p(2) = 1. Ví dụ 1 1 2 3 5 8 13 21…
Hãy lập chương trình con đệ quy để tạo ra dãy số đó
4. Đảo chữ số
Viết chương trình con đảo các chữ số của 1 số. Yêu cầu sử dụng chương trình
con đệ quy
VD đảo số: Đọc vào một số: 12345
Đảo số in ra:
54321
uses crt;
var m,n:longint;tong,dem:byte;
BEGIN
clrscr;
write('Nhap so n: ');readln(n);
m:=n;dem:=0;tong:=0;
while m>0 do
begin
tong:=tong+ m mod 10;
dem:=dem+1;
m:=m div 10;
8


end;
writeln(n,' co ',dem,' chu so va tong cac chu so cua ',n,' la: ',tong);
write('So dao nguoc cua ',n,' la: ');
m:=n;
while m>0 do
begin

write(m mod 10);
m:=m div 10;
end;
readln
END.

5. Viết Function tính an với a: real, n nguyên dương theo 2 cách
- Tính trực tiếp, không đệ quy
- Theo thuật toán đệ quy.
Program Fibonacci;
Uses CRT;
Var n,i:shortint;
F:real;
CH:char;
Label 1;
Procedure FB(n:shortint);
Var a,b:Real;
Begin
If (n=1) or (n=2) Then
F:=1
Else Begin
FB(n-1);
a:=F;
FB(n-2);
b:=F;
F:=a+b;
End;
End;
Begin
1: ClrScr;

Write(‘N = ‘);Readln(n);
If n>40 Then
9


Begin
Writeln(‘n phai nho hon hoac bang 40′);
Writeln;
GOTO 1;
End;
Writeln;
For i:=1 to n Do
Begin
FB(i);
Write(F:0:0,’ ‘);
End;
Writeln;Writeln;
Write(‘Ban co muon tinh lai ko? (Y/N)’);CH:= ReadKey;
Writeln;Writeln;
If (CH=’Y') or (CH=’y') Then GOTO 1;
End.

6. Viết hàm tìm Max của 3 số thực x,y,z.
Function Max(x,y: Real) : Real;
Begin
If X >y then Max := x else Max := y;
End;
Còn chương trình hoàn chỉnh:
Program Tim_So_Lon;
Var a, b : Real;

Function Max(x,y: Real) : Real;
Begin
If x >y then Max := x else Max := y;
End;
Begin
Write('Nhap vao 2 so thuc : '); Readln(a,b);
Write('So lon nhat la : ',Max(a,b):6:4);
Readln
End.
------Program Tim_max;
var a,b,c,max : integer;
Begin
writeln('Tim MAX cua 3 so a,b,c');
write('Nhap so a :');readln(a);
write('Nhap so b :');readln(b);
write('Nhap so c :');readln(c);
max:= a;
10


if max < b then max := b;
if max < c then max := c;
writeln( 'So Max trong 3 so la : ', max );
readln;
end.

7. Viết thủ tục để hoán đổi hai gía trị x,y cho nhau.
Giải: Đổi hai chữ số cho nhau:
Program CTC_1;
uses crt;

var a,b: real;
{----CTC doi gia tri----}
Procedure swap(var x,y:real);
var tam:real;
begin
tam:=x; x:=y; y:=tam;
end;
{-----Ket thuc CTC-----}
begin
clrscr;
write('Nhap so a: ');readln(a);
write('Nhap so b: ');readln(b);
swap(a,b);
write('Sau khi doi a =',a:3:1);
write('Sau khi doi b =',b:3:1);
readln
end.
III. MẢNG
1. Viết chương trình tìm giá trị lớn nhất của một mảng chứa các số nguyên
gồm N phần tử.
Uses Crt;
Type Mang = ARRAY[1..50] Of Integer;
Var A:Mang;
N,i,Max:Integer;
Begin
Write('Nhap N='); Readln(N);
For i:=1 To N Do
Begin
Write('A[',i,']='); Readln(A[i]);
End;

Max:=A[1];
For i:=2 To N Do
If MaxWriteln('Phan tu lon nhat cua mang:', Max);
11


Readln;
End.
2. Viết chương trình tính tổng bình phương của các số âm trong một mảng
gồm N phần tử.
Uses Crt;
Type Mang = ARRAY[1..50] Of Integer;
Var A:Mang;
N,i,S:Integer;
Begin
clrscr;
Write(‘Nhap N=’); Readln(N);
For i:=1 To N Do
Begin
Write(‘A[‘,i,’]=’); Readln(A[i]);
End;
S:=0;
For i:=1 To N Do
If A[i]<0 Then S:=S+A[i]*A[i];
Writeln(‘S= ’, S);
Readln;
End.
3. Viết chương trình nhập vào một mảng gồm N số nguyên. Sắp xếp lại mảng
theo thứ tự tăng dần và in kết quả ra màn hình dãy trước và sau khi sắp xếp.

Viết chương trình nhập vào một mảng gồm N số nguyên.
Sắp xếp lại mảng theo thứ tự tăng dần và in kết quả ra màn
hình.
Uses Crt;
Type Mang = ARRAY[1..50] Of Integer;
Var A:Mang;
N,i,j,Tam:Integer;
Begin
clrscr;
Write('Nhap N='); Readln(N);
For i:=1 To N Do
Begin
Write('A[',i,']='); Readln(A[i]);
End;
For i:=1 To N-1 Do
For j:=i+1 To N Do
If A[i]>A[j] Then
Begin
Tam:=A[i]; A[i]:=A[j]; A[j]:=Tam;
End;
Writeln('Ket qua sau khi sap xep:');
For i:=1 To N Do Write(A[i]:5);
12


Readln;
End.
4. Viết chương trình nhập vào một mảng A gồm N số nguyên và nhập thêm
vào một số nguyên X. Hãy kiểm tra xem phần tử X có trong mảng A hay
không?

Uses Crt;
Type Mang = ARRAY[1..50] Of Integer;
Var A:Mang;
N,i,x:Integer;
Function TimKiem(x, N: Integer; A:Mang):Integer;
Var i:Integer;
Begin
clrscr;
I:=1;
While (I <= N) and (X<>A[I]) do I:=I+1;
If I <= N Then Timkiem:=I Else Timkiem:=0;
End;
Begin
Write(‘Nhap N=’); Readln(N);
For i:=1 To N Do
Begin
Write(‘A[‘,i,’]=’); Readln(A[i]);
End;
Write(‘Nhap X=’); Readln(x);
If TimKiem(X,N,A)<>0 Then
Writeln(‘Vi tri cua X trong mang la:’, TimKiem(X,N,A))
Else
Writeln(‘X khong co trong mang.’);
Readln;
End.
5. Giả sử mảng A đã được sắp xếp theo thứ tự tăng dần. Viết hàm để kiểm tra
xem phần tử X có trong mảng A hay không?
Function TimKiemNhiPhan(X, N: Integer; A: Mang):Integer;
Var dau,cuoi,giua:Integer;
Found:Boolean;

Begin
dau:=1; {điểm mút trái của khoảng tìm kiếm}
cuoi:=N; {điểm mút phải của khoảng tìm kiếm}
Found:=False; {chưa tìm thấy}
While (dau <=cuoi) and (Not Found) Do
Begin
giua:=(dau + cuoi) Div 2;
If X = A[giua] Then Found:=True {đã tìm thấy}
Else
13


If X > A[giua] Then dau:=giua+1
Else cuoi:=giua-1;
End;
If Found Then TimKiemNhiPhan:= giua Else TimKiemNhiPhan:=0;
End;
6. Viết chương trình in ra màn hình tam giác Pascal. Ví dụ, với n=5 sẽ in ra
hình sau:
1
1
1
1
2
1
1
3
3
1
1

4
6
4
1
Giải:
Program tamgiac;
Uses Crt;
Var
a:array[0..9] of byte;
i,j:byte;
Begin
Clrscr;
Writeln;
Writeln;
Writeln('Tam giac Pascal :');
Writeln; Writeln;
For i:=0 to 9 do
Begin
For j:=i downto 0 do
If (j=i)or(j=0) then a[j]:=1 Else a[j]:=a[j]
+a[j-1];
For j:=0 to i do Write(a[j]:5);
Writeln;
End;
Readln;
End.
7. Nhập vào một mảng các số nguyên.
a/ Xếp lại mảng đó theo thứ tự giảm dần.
b/ Nhập vào một số nguyên từ bàn phím. Chèn số đó vào mảng sao cho
mảng vẫn có thứ tự giảm dần. (không được xếp lại mảng)

Program nhap_Mang_va_chen_phan_tu;
uses crt;
var
n,x : integer;
a : array[1..30] of integer;
procedure nhap;
14


var i : integer;
Begin
clrscr;
Write('Nhap vao so n : ');readln(n);
writeln('Nhap mang 1 chieu ' ,n ,' phan tu!' );
for i := 1 to n do
begin
write('A[',i,']= ');
readln(A[i]);
end;
end;
procedure sxep;
var i,j,tg : integer;
begin
for i := 1 to n-1 do
for j := i + 1 to n do
if a[i] < a[j] then begin
tg := a[i]; a[i] := a[j]; a[j] := tg;
end;
writeln('DAY SAU KHI SAP XEP GIAM DAN:');
for i := 1 to n do writeln(a[i]);

end;
procedure chen;
var
i,k: integer;
begin
Write('Nhap vao so nguyen x : ');readln(x);
i := 1;
k:= n+1;
while (i<=n) and (k=n+1) do
begin
if x > a[i] then k := i;
i:= i + 1;
end;
for i := n downto k do a[i + 1] := a[i];
a[k]:= x;
writeln('DAY SAU KHI CHEN x:');
for i := 1 to n + 1 do writeln(a[i]);
end;
BEGIN
15


nhap;
sxep;
chen;
readln;
END.
8. Cho 2 mảng số nguyên: Mảng A có m phần tử, mảng B có n phần tử.
a/ Sắp xếp lại các mảng đó theo thứ tự giảm dần.
b/ Trộn 2 mảng đó lại thành mảng C sao cho mảng C vẫn có thứ tự giảm

dần (Không được xếp lại mảng C).
uses crt;
type ArrInt = array[1..100] of integer;
var n,i,j,k,tm: integer;
a,b,c: ArrInt;
Procedure nhap(var arr: ArrInt);
begin
for i:=1 to n do
begin
write('Phan tu thu ',i,' = ');
readln(arr[i]);
end;
end;
Procedure ghep_mang;
begin
i:=1;
j:=1;
k:=1;
repeat
if((a[i]>=b[j])and(i<=n))or(j>n) then
begin
c[k]:=a[i];
k:=k+1;
i:=i+1;
end;
if((a[i]begin
c[k]:=b[j];
k:=k+1;
j:=j+1;

end;
until(k>2*n);
end;
Procedure sap_xep(var arr: ArrInt);
begin
16


for i:=1 to n-1 do
for j:=i+1 to n do
if arr[i]begin
tm:=arr[i];
arr[i]:=arr[j];
arr[j]:=tm;
end;
end;
begin
clrscr;
write('Nhap so phan tu cua day so, N= ');
readln(n);
writeln('Nhap mang a[]: ');
nhap(a);
writeln('Nhap mang b[]: ');
nhap(b);
sap_xep(a);
sap_xep(b);
ghep_mang;
writeln('Mang sau khi ghep: ');
for i:=1 to 2*n do

write(c[i],' ');
writeln;
readln;
end.
9. Đọc vào n số nguyên từ bàn phím
a) Đếm các số chia hết cho 3.
b) Đếm các số lớn hơn 10.
c) Đếm các số nằm trong đoạn [10,500].
d) Đếm xem có bao nhiêu số bằng số lớn nhất.
Var A:array[1..100] Of integer;
n,i,d3,d10,dem,d:integer;
BEGIN
Readln(n);
d3:=0;
d10:=0;
dem:=0;
d:=-1;
For i:=1 to n do
Begin
readln(A[i]);
If A[i] mod 3=0 then inc(d3);
If A[i]>10 then inc(d10);
17


If (A[i]>=10) and (A[i]<=500) then inc(dem);
If A[i]>max then max:=A[i];
End;
For i:=1 to n do if A[i]=max then inc(d);
Writeln('Co

Writeln('Co
Writeln('Co
Writeln('Co
readln
end.

',
',
',
',

d3,' so chia het cho 3');
d10,' so >10 ');
dem,' so trong khoang [10..500]');
d,' so bang so lon nhat');

10. Đọc vào n số nguyên từ bàn phím
a) Tính tổng và trung bình cộng của các số đã cho.
b) Tính tổng các số lẻ và trung bình cộng các số chẵn.
c) Tính trung bình cộng của các số thuộc đoạn [10,100].
var
a:array[1..100]of integer;
i,s1,d,n:integer;
s:real;
Begin
write('n= ');readln(n);
for i:=1 to n do
begin
write('a[',i,']=');
readln(a[i]);

end;
s:=0;
for i:=1 to n do s:=s+a[i];
s:=s/n;
writeln('trung binh cong cua cac so la: ',s:2:2);
s:=0;
s1:=0;
d:=0;
for i:=1 to n do
begin
if a[i] mod 2=0 then
begin
s:=s+a[i];
inc(d);
end;
if a[i] mod 2=1 then s1:=s1+a[i];
end;
s:=s/d;
writeln('tong cac so le la: ',s1);
writeln(' trung binh cong cac so chan la: ',s:2:2);
s:=0;
18


d:=0;
for i:=1 to n do
if (a[i]<=100) and (a[i]>=10) then
begin
s:=s+a[i];
inc(d);

end;
s:=s/d;
writeln('TBC cac so thuoc doan [10,100] la: ', s:2:2);
readln;
end.
11. Đọc vào từ bàn phím dãy n số nguyên. Sắp xếp các số lẻ lên đầu dãy, số
chẵn xuống cuối dãy. In ra dãy trước và sau khi sắp xếp.
Var n:integer;
A:array[1..100] Of integer;
Procedure Init;
Var i:integer;
Begin
Readln(n);
For i:=1 to n do readln(A[i]);
Writeln;
For i:=1 to n do write(A[i],' ');writeln;
End;
Procedure Xuly;
Var i,j,t:integer;
Begin
For i:=1 to n do
If A[i] mod 2=1 then
Begin
For j:=1 to i-1 do
If A[j] mod =0 then
Begin
t:=A[i];
A[i]:=A[j];
A[j]:=t;
Break;

End;
End;
writeln;
For i:=1 to n do write(A[i],' ');
End;
BEGIN
Init;
19


Xuly;
readln
End.
12. Đọc vào n số. Đọc thêm một số x. Chèn số x vào vị trí thứ 2 của dãy. Đưa ra
màn hình dãy trước và sau khi chèn x.
Var n,x:integer;
A:array[1..100] Of integer;
Procedure Init;
Var i,j:integer;
Begin
Readln(n, x);
For i:=1 to n do readln(A[i],' ');
writeln;
For i:=1 to n do write(A[i],' ');writeln;
For i:= n+1 downto 3 do A[i]:=A[i-1];
inc(n);
A[2]:=x;
For i:=1 to n do write(A[i],' ');writeln;
End;
BEGIN

Init;
readln
End.
13. Đọc vào n số. Đọc thêm 1 số x. Chèn số x vào vị trí thứ k của dãy, với k đọc từ
bàn phím. Nếu k>n thì thêm x vào vị trí thứ n+1. Đưa ra màn hình dãy trước và sau
khi chèn x.
14. Viết chương trình nhập vào từ bàn phím mảng 2 chiều B có n dòng, m cột. In ra
màn hình mảng 2 chiều đó.
program vd_mang_2chieu;
var a:array[1..100,1..100] of integer;
i,j: integer;
begin
write(‘Nhap cac kich thuoc cho mang m,n:=’);
readln(m,n);
write(‘Nhap cac phan tu cua mang’);
20


for i:=1 to m do
for j:=1 to n do
begin
write(‘a[',i,j,']:=’);
readln(a[i,j]);
end;
writeln(‘Mảng mới nhập vào’);
for i:=1 to m do
begin
for j:=1 to n do
write(a[i,j]);
writeln;

end;
readln;
end.

15. Nhập vào mảng 2 chiều B có n dòng, m cột. Đếm xem có bao nhiêu phần tử
B[i,j] chia hết cho (i+j) và tính tổng của chúng. Đưa ra mảng B và các kết quả tính
toán ra màn hình.
16. Đọc vào dãy gồm n số. Xoá bỏ số ở vị trí thứ k (xoá bỏ phần tử thứ k) của dãy,
với k đọc từ bàn phím. Đưa dãy ban đầu và dãy sau khi xoá ra màn hình.
Giải:

var i,k:integer;
s,s1:string;
begin
write('nhap xau can xu li: '); readln(s);
write('nhap vi tri cua ki tu can xoa: '); readln(k);
s1:='';
for i:=1 to k-1 do s1:=s1+s;
for i:=k+1 to length(s) do s1:=s1+s;
writeln('xau da xoa ki tu duoc yeu cau la: ',s1);
21


readln;
end.
17. Đọc vào dãy n số nguyên từ bàn phím. Đếm xem trong dãy có bao nhiêu số là
số nguyên tố. Đưa ra màn hình số lượng và các số là số nguyên tố.
Uses crt;
var a: array [1..1000] of integer;
i, n, dem: integer;

function KT (so: integer) : boolean;
var z: integer;
begin
z:=2; while so mod z <> 0 do inc (z);
if so=z then KT:=True else KT:=False;
end;
begin
clrscr;
write ('Nhap so phan tu: '); readln (n);
for i:= 1 to n do
begin
write ('Nhap phan tu thu ',i,': '); readln (a);
if KT(a)=True then inc (dem);
end;
if dem=0 then
begin
write ('Khong co so nguyen to!');
readln; exit;
end;
writeln (Day co ',dem,' so nguyen to: ');
for i:= 1 to n do
if KT(a)=True then write (a,' ');
readln
end.
IV. XÂU KÝ TỰ
1. Viết chương trình nhập vào một xâu ký tự từ bàn phím. Đổi xâu ký tự đó sang
chữ in hoa rồi in kết quả ra màn hình.
Ví dụ :Xâu abcdAbcD sẽ cho ra xâu ABCDABCD.
uses crt;
Var S : string; i : integer;

BEGIN
clrscr;
Write('Cho mot xau ky tu: '); Readln(S);
For i:=1 to length(S) do
If S[i] in ['a' ..'z'] then S[i]:= Upcase(S[i]);
Write('Chuoi sau khi da bien doi la: ', S);
Readln;
END .
22


-----------------------------------------------------------------------------------Uses Crt;
Var St:String;
i:Byte;
Begin
Write(‘Nhap xau St: ‘); Readln(St);
For i:=1 to length(St) do St[i]:=Upcase(St[i]);
Write(‘Xau ket qua: ‘, St);
Readln;
End.
Bài phụ: Viết chương trình nhập vào một xâu ký tự từ bàn phím. Đổi xâu ký
tự đó sang chữ thường rồi in kết quả ra màn hình.
Ví dụ :Xâu abCdAbcD sẽ cho ra xâu abcdabcd.
Uses Crt;
Var St:String;
i:Byte;
Begin
Write(‘Nhap xau St: ‘); Readln(St);
For i:=1 to length(St) do
If St[i] IN [‘A’..’Z’] Then St[i]:=CHR(ORD(St[i])+32);

Write(‘Xau ket qua: ‘, St);
Readln;
End.
2. Viết chương trình đếm số ký tự chữ số trong một xâu ký tự được nhập vào từ
bàn phím.
Uses Crt;
Var St:String;
i,d:Byte;
Begin
Write(‘Nhap xau St: ‘); Readln(St);
For i:=1 to length(St) do
If St[i] IN [‘0’..’9’] Then d:=d+1;
Write(‘So ky tu chu so trong xau: ‘, d);
Readln;
End.
3. Viết chương trình nhập một xâu từ bàn phím. In ra xâu đó sau khi xóa hết các ký
tự trắng thừa trong xâu. (Ký tự trắng thừa là các ký tự trắng đầu xâu, cuối xâu và
nếu ở giữa xâu có 2 ký tự trắng liên tiếp nhau thì có 1 ký tự trắng thừa).
Giải:
Uses Crt;
Var St:String;
Procedure XoaTrangThua(Var St:String);
Begin
While St[1]=#32 Do Delete(St,1,1);
While St[Length(St)]=#32 Do Delete(St,Length(St),1);
23


While POS(#32#32,St)<>0 Do Delete(St,POS(#32#32,St),1);
End;

Begin
Write(‘Nhap xau St: ‘); Readln(St);
XoaTrangThua(St);
Write(‘Xau sau khi xoa cac ky tu trang thua: ‘, St);
Readln;
End.
***********************************************
program xoakytutrang;
var st:string;
i,n,k:byte;
begin
write('Nhap xau: ');
readln(st);
while st[1]=' ' do
delete(st,1,1);
k:=pos(' ',st);
while k<>0 do
begin
delete(st,k,1);
k:=pos(' ',st);
end;
n:=length(st);
while st[n]=' ' do
begin
delete(st,n,1);
n:=length(st);
end;
write('Xau sau khi xu ly: ',st);
readln;
end.

4. Viết chương trình liệt kê các từ của một xâu ký tự được nhập vào từ bàn phím,
mỗi từ phải được viết trên một dòng.
Uses Crt;
Var St:String;
Procedure XoaTrangThua(Var St:String);
Begin
While St[1]=#32 Do Delete(St,1,1);
While St[Length(St)]=#32 Do Delete(St,Length(St),1);
While POS(#32#32,St)<>0 Do Delete(St,POS(#32#32,St),1);
End;
Begin
Write(‘Nhap xau St: ‘); Readln(St);
24


XoaTrangThua(St);
St:=St+#32;
Writeln(‘Liet ke cac tu trong xau: ‘);
While POS(#32,St)<>0 Do
Begin
Writeln(Copy(St,1,POS(#32,St)));
Delete(St,1,POS(#32,St));
End;
Readln;
End.
5. Viết chương trình nhập vào một xâu ký tự từ bàn phím. Tìm xâu đảo ngược của
xâu đó rồi in kết quả ra màn hình theo 2 cách: Đệ qui và không đệ qui.
Uses Crt;
Var St:String;
{Giải thuật không đệ qui}

Function XauDao(St:String):String;
Var S:String;
i:Byte;
Begin
S:=’’;
For i:=Length(St) DowTo 1 Do S:=S+St[i];
XauDao:=S;
End;
{Giải thuật đệ qui}
Function DeQui(St:String):String;
Begin
If Length(St)<=1 Then DeQui:=St
Else DeQui:=St[Length(St)] + DeQui(Copy(St,1,Length(St)-1));
End;
Begin
Write(‘Nhap xau St: ‘); Readln(St);
Write(‘Xau dao nguoc: ‘, XauDao(St));
Readln;
End.
6. Viết chương trình nhập vào một xâu ký tự từ bàn phím. Thông báo lên màn hình
các chữ cái có trong xâu và số lượng của chúng ( Không phân biệt chữ hoa hay chữ
thường).
Uses Crt;
Var St:String;
dem: Array[‘A’..’Z’] Of Byte;
i:Byte;
25