Bai tap pascal(co dap an)

B i 1à :
Nhập 3 số a , b , c bất kì . Hãy kiểm tra xem ba số đó có thể là độ dài ba cạnh của
một tam giác hay không ? Thông báo lên màn hình ‘ Thỏa mãn ‘, ‘ Không thỏa mãn
trong từng trường hợp tương ứng .
Var
a , b , c : Real ;
BEGIN
Writeln (' Nhap do dai 3 canh cua tam giac : ') ;
Write (' a = ') ; Readln ( a ) ;
Write (' b = ') ; Readln ( b ) ;
Write (' c = ') ; Readln ( c ) ;
If ( a + b > c ) and ( b + c > a ) and ( c + a > b )
and ( a > 0 ) and ( b > 0 ) and ( c > 0 ) Then
Writeln (' Thoa man : Day la 3 canh cua mot tam giac ')
Else
Writeln (' Khong thoa man ! ') ;
Readln ;
END .
B i 2à :
Nhập N số bất kì .
Đếm các số lớn hơn 10 và nhỏ hơn 20 và tính tổng của chúng . Sau đó , đưa ra
màn hình :
So cac so >10 và <20 la : ( gia tri )
Tong cua chung la : ( gia tri )
Var
Tong , So : Real ;
I , N , Dem : Integer ;
BEGIN
Write (' Bao nhieu so : ') ; Readln ( N ) ;
Tong := 0 ; Dem := 0 ;
For I := 1 To N Do

Begin
Write (' So = ') ; Readln ( So ) ;
If ( So > 10 ) and ( So < 20 ) Then
Begin
Tong := Tong + So ;
Dem := Dem + 1 ;
End ;
End ;
Writeln (' So cac so >10 va <20 la : ', Dem ) ;
Writeln (' Tong cua chung la :', Tong ) ;
Readln ;
END .
B i 3à :
Nhập bốn số a , b , c , d . Hãy tìm giá trị lớn nhất của chúng và gán giá trị lớn
nhất đó cho biến Max .
Var
Max , a , b , c , d : Real ;
BEGIN
Writeln (' Nhap gia tri cua 4 so : ') ;
Write (' a = ') ; Readln ( a ) ;
Write (' b = ') ; Readln ( b ) ;
Write (' c = ') ; Readln ( c ) ;
Write (' d = ') ; Readln ( d ) ;
Max := a ;
If Max < b Then Max := b ;
If Max < c Then Max := c ;
If Max < d Then Max := d ;
Writeln (' Gia tri lon nhat la : ', Max ) ;
Readln ;
END .

B i 4à :
Đọc ngày tháng năm , sau đó viết ra màn hình đó là ngày thứ mấy trong tuần .
Var
Thu , Ngay , Thang : Byte ;
Nam : Integer ;
BEGIN
Write (' Doc Ngay Thang Nam : ') ;
Readln ( Ngay , Thang , Nam ) ;
Nam := 1900 + ( Nam mod 1900 ) ;
If Thang < 3 Then
Begin
Thang := Thang + 12 ;
Nam := Nam - 1 ;
End ;
Thu := Abs ( Ngay + Thang * 2 + ( Thang + 1 ) * 3
div 5 + Nam + Nam div 4 ) mod 7 ;
Case Thu Of
0 : Writeln (' Chu Nhat ') ;
1 : Writeln (' Thu Hai ') ;
2 : Writeln (' Thu Ba ') ;
3 : Writeln (' Thu Tu ') ;
4 : Writeln (' Thu Nam ') ;
5 : Writeln (' Thu Sau ') ;
6 : Writeln (' Thu Bay ') ;
End ;
Readln ;
END .
B i 5à :
Viết chương trình :
Nhâp số báo danh

Nhập điểm văn , toán , ngoại ngữ
In ra màn hình dưới dạng :
_ Phiếu điểm :
_ Số báo danh :
_ Điểm văn :
_ Điểm toán :
_ Điểm ngoại ngữ :
_ Tổng số điểm :
Bạn đã trúng tuyển ( hoặc Bạn đã không trúng tuyển ) với điều kiện Tổng số
điểm >= 15 hay ngược lại .
Uses Crt ;
Var SBD : Integer;
Van , Toan , Ngoaingu , Tongdiem : Real ;
BEGIN
Clrscr ;
Write (' So bao danh : ') ; Readln( SBD ) ;
Write (' Diem toan : ') ; Readln( Toan ) ;
Write (' Diem ngoai ngu : ') ; Readln( Ngoaingu ) ;
Write (' Diem van : ') ; Readln ( Van ) ;
Tongdiem := Toan + Van + Ngoaingu ;
Clrscr ;
Writeln (' Phieu Bao Diem ') ;
Writeln (' So bao danh : ', SBD ) ;
Writeln (' Diem van : ', Van ) ;
Writeln (' Diem toan : ', Toan ) ;
Writeln (' Diem ngoai ngu : ', Ngoaingu) ;
Writeln (' Tong diem : ', Tongdiem) ;
If Tongdiem >= 15 Then
Writeln(' Ban da trung tuyen ')
Else

Writeln(' Ban khong trung tuyen ') ;
Readln ;
END .
B i 6à :
Viết chương trình nhập hai số thực . Sau đó hỏi phép tính cần thực hiện và in
kết quả của phép tính đó .
Nếu là “+” , in kết quả của tổng lên màn hình .
Nếu là “-” , in kết quả của hiệu lên màn hình .
Nếu là “/” , in kết quả của thương lên màn hình .
Nếu là “*” , in kết quả của tích lên màn hình . Nếu là “+” , in kết quả của
tổng lên màn hình .
Nếu là “+” , in kết quả của tổng lên màn hình .
Uses Crt ;
Var
a , b , T : Real ;
Pt : Char ;
BEGIN
Clrscr ;
Write (' a = ') ; Readln( a ) ;
Write (' b = ') ; Readln( b ) ;
Write (' Phep tinh thuc hien la (+ - * /) : ') ;
Readln( Pt ) ;
If Pt = '+’ Then T := a + b ;
If Pt = '-’ Then T := a - b ;
If Pt = '*’ Then T := a * b ;
If Pt = '/’ Then T := a / b ;
Write ( a , pt , b , ' = ', T ) ;
Readln ;
END .
B i 7à :

Giải và biện luận phương trình :
x
2
+ ( m – 2 ) x + 1 = 0
ở đây m là tham số thực tuỳ ý .
Uses Crt;
Var
m , Delta : Real ;

BEGIN
Clrscr;
Write (' m = ') ; Readln( m ) ;
Delta := sqr( m-2 ) - 4 ;
If Delta < 0 Then
Writeln(' Phuong trinh vo nghiem ')
Else
Begin
If Delta = 0 Then
Writeln(' Phuong trinh co nghiem kep X= ', -( m - 2 ) / 2 )
Else
Begin
Writeln(' Phuong trinh co 2 nghiem : ') ;
Writeln (' X1 = ', ( -(m-2) + sqrt(delta) ) / 2 ) ;
Writeln (' X2 = ', ( -(m-2) - sqrt(Delta) ) / 2 ) ;
End ;
End ;
Readln ;
END .
B i 8à :
Viết chương trình nhập hai số tự nhiên N, M và thông báo ‘Dung‘ nếu N , M

cùng tính chẵn lẽ , trong trường hợp ngược lại thì thông báo ‘Sai‘.
Uses Crt ;
Var
N , M : Integer ;
Begin
Clrscr ;
Write(' N , M = ') ; Readln( N , M ) ;
If ( (N + M) mod 2 = 0 ) Then Writeln(' Dung ! ')
Else Writeln(' Sai ! ') ;
Readln ;
END .
Sử dụng lệnh For
B i 1à :
Lập trình tính tích các số tự nhiên từ 1 tới 10 .
Var i : Byte ; (* chỉ số chạy *)
p : word ; (* tích số *)
BEGIN
p := 1; (* cho giá trò ban đầu của tích *)
For i := 1 to 10 Do (* cho i chạy từ 1 tới 10 *)
p := p * i ; (* lần lượt nhân i với p *)
Write (' 1 * 2 * * 10 = ', p ) ;
Readln ;
END .
B i 2à :
Viết chương trình đếm số lần xuất hiện của các kí tự thuộc bảng chữ cái trong
50 lần gõ kí tự bằng bàn phím (khơng phân biệt a với A, b với B …, dùng hàm
Upcase để chuyển đổi chữ thường với chữ hoa) .
Uses Crt ;
Var a : Array[ 'A' 'Z' ] of integer; (* mảng bộ đếm *)
ch : char ; (* biến nhập kí tựù *)

i : byte ; (* chỉ số của lần gõ phím *)
BEGIN
Clrscr ;
For ch :='A' to 'Z' Do a[ch] := 0 ; (* xả bộ đếm *)
Writeln (' Go phim 50 lan ') ;
For i := 1 To 50 Do (* thực hiện 100 lần *)
Begin
ch :=Readkey ; (* nhập kí tự vào Ch không cần gõ Enter *)
ch := Upcase(ch) ; (* Đỗi chữ thường thành chữ hoa *)
a[ch] := a[ch] + 1 ;
End;
Writeln (' So lan xuat hien cac ki tu la :') ;
For ch :='A' to 'Z' do (* Kiểm tra bộ đếm từ 'A' tới 'Z' *)
If a[ch] > 0 Then (* Nếu Ch có xuất hiện *)
Writeln (ch , a[ch] : 4 , ' lan . ') ; (* Viết ra màn hình kí
tự và
số lần xuất hiện *)
Readln ;
END .
B i 3à :
Cho số tự nhiên n , hãy lập trình để tính các tổng sau :
a. a. 1 + 1/2
2
+ 1/3
2
+ … + 1/n
2

b. b. 1 + 1/2! + 1/3! + … + 1/n!
a)

Var n , i : Word ;
S : Real ;
BEGIN
Write (' Nhap n : ') ; Readln (n) ;
S := 0 ;
For i := 1 To n Do
S := S + 1 / sqr(i) ;
Writeln (' S = ', S:0:2) ;
Readln ;
END .
b)
Var n , i , j , p : Word ;
S : Real ;

BEGIN
Write (' Nhap n : ') ; Readln(n) ;
p := 1 ;
s := 0 ;
For i :=1 To n Do
Begin
p := p * i ; (* tính i *)
S := S + 1 / p ;
End ;
Writeln (' S = ', S:0:2) ;
Readln ;
END .
B i 4à :
Tính giá trị của biểu thức sau :
( 1 + 1/1
2

) ( 1 + 1/2
2
) … ( 1 + 1/n
2
)
Var i , n : Byte ;
p : Real ;
Begin
Write(' Nhap n : ') ; Readln (n) ;
p := 1 ;
For i := 1 To n Do p := p * ( 1 + 1/sqr(i) ) ;
Writeln(' p = ', p:10:5 ) ;
Readln ;
End .
Sử dụng lệnh While
B i 5à :
Lập trình tính tổng :
A = 1 + 1/2 + 1/3 + … + 1/n
ở đây n là số tự nhiên được nhập vào từ bàn phím .
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
Begin
tong := tong + 1/i ;

i := i + 1 ;
End ;
Writeln (' Tong can tim la : ', tong:12:6 ) ;
Readln ;
END .
B i 6à :
Tính hàm lũy thừa a
n
, ở đây a thực và n tự nhiên được nhập vào từ bàn phím .
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 ;
End ;
Writeln(' a mu n bang : ', giatri ) ;
Readln ;
END .
B i 7à :
Viết chương trình nhập một dãy số tối đa 100 số , sau đó in ra màn hình các số
khác nhau .
Uses Crt;

Var A : Array [1 100] Of Integer;
i , j , n : Integer ;
BEGIN
Clrscr ;
Write(' Do dai cua day so N = ') ; Readln (N) ;
For I := 1 To N Do
Begin
Write ('A[', i , ']= ') ; Readln ( A[i] ) ;
End ;
Writeln (' Cac so khac nhau la : ') ; Writeln ( A[1] ) ;
i := 2 ;
While i <= N Do
Begin
j := 1 ;
While ( j < i ) and ( A[j] <> A[i] ) Do inc(j) ;
If j = i Then Writeln( A[i] ) ;
i :=i + 1 ;
End ;
Readln ;
END .
B i 8à :
Viết chương trình nhập một dãy số tối đa 100 số , sau đó sắp xếp lại theo thứ
tự tăng dần .
Uses Crt;
Var A : Array [1 100] Of Integer ;
i , j , n , T : Integer ;
BEGIN
Clrscr ;
Write(' Do dai cua day so N = ') ; Readln (N) ;
Writeln (' Nhap day so : ') ;

For i := 1 To N Do
Begin
Write('A[', i ,'] = ') ; Readln ( A[i] ) ;
End ;
i := 1 ;
While (i <= n-1) Do
Begin
j := i+1;
While j<=n do
Begin
If A[j] < A[i] then
Begin
T := A[j];
A[j ] := A[i];
A[i] := T ;
End ;
j := j + 1;
End ;
i := i + 1;
End ;
Writeln(' Day sau khi sap xep : ') ;
For i := 1 To N Do Write(A[i] : 4) ;
Readln ;
END .
Sử dụng lệnh Repeat
B i 9à :
Cho một dãy số được nhập từ bàn phím . Hãy viết chương trình nhập một số a
rồi liệt kê tất cả các phần tử trong dãy lớn hơn a.
Uses Crt ;
Var b : Array[1 100] Of Real;

a : Real ;
n , i : Byte ;
BEGIN
Clrscr ;
Write ('Nhap do dai cua day so : ') ; Readln(n) ;
Writeln (' Nhap cac phan tu cua day : ') ;
For i := 1 To n Do
Begin
Write (' b[', i ,'] = ') ; Readln( b[i] ) ;
End ;
Write (' Nhap so thuc a : ') ; Readln(a) ;
Writeln (' Cac phan tu lon hon a cua day : ') ;
i:=1;
Repeat
If ( b[i] > a ) Then Writeln (' b[', i ,'] = ', b[i]:8:2 ) ;
inc(i) ;
Until i > n ;
Readln ;
END .
B i 10à :
Viết chương trình nhập một dãy số tối đa 50 số rồi in ra màn hình các số trùng
nhau của dãy .
Uses crt ;
Var a , b : Array[1 50] Of Integer ;
n , m , i , j , k : Byte ;
trung : Boolean ;
BEGIN
Clrscr ;
Write (' Nhap do dai cua day so nguyen : ') ; Readln(n) ;
Writeln (' Nhap cac phan tu cua day : ') ;

For i := 1 To N do
Begin
Write (' a[', i ,'] = ') ; Readln( a[i] ) ;
End ;
i := 1 ; m := 0 ;
Repeat
trung := false ;
j := i + 1;
Repeat
If ( j <= n ) and ( a[i] = a[j] ) Then trung := true ;
inc (j) ;
Until trung or ( j > n ) ;
If trung Then
Begin
m := m + 1;
b[m] := a[i] ; writeln ( b[m] : 4 ) ;
End ;
inc(i) ;
Until i > n ;
If m > 1 Then
Begin
i := 1 ;
Repeat
j := i + 1 ;
Repeat
trung := false ;
If b[i] = b[j] Then trung := true ;
If trung Then
Begin
If j < m Then

For k := j To m - 1 Do b[k] := b[k + 1] ;
m := m - 1 ;
dec ( j ) ;
End ;
inc ( j ) ;
Until j > m ;
inc ( i ) ;
Until i > m ;
End ;
If m > 0 Then
For k := 1 To m Do Write ( b[k] : 4 ) ;
Readln ;
END .
B i 11à :
Bạn có 1000 đ đem gửi ngân hàng với lãi suất 8%/tháng . Sau mỗi tháng tiền
lãi được nhập vào để tính lãi suất tháng sau . Bạn muốn để dành cho đến khi
số tiền tăng lên là x . Vậy phải để trong bao lâu
uses crt ;
var
thang : Byte ;
tien , lai , x : Real ;
BEGIN
clrscr ;
writeln (' Chuong trinh tinh thoi gian rut tien lai ') ;
write (' So tien lai muon rut ra : ') ; readln(x) ;
tien := 1000 ;
thang :=1 ;
repeat
lai := tien * 8 / 100 ;
tien := tien + lai ;

thang := thang + 1 ;
until tien >= x ;
writeln (' Ban phai gui tien trong ', thang div 12 , ' nam ',
thang mod 12 ,' thang .') ;
writeln (' Khi do so tien ban rut ra duoc la ', tien:12:2 ,'
dong .') ;
readln ;
END .
B i 12à :
Viết chương trình tìm ƯSCLN của N số được nhập từ bàn phím .
Uses crt ;
Var a : Array [1 100] Of Integer ;
n , i : Byte ;
d : integer ;
BEGIN
Clrscr ;
Writeln (' Tim USCLN cua N so :') ;
Write (' Nhap so N : ') ; Readln(n) ;
Writeln ('Nhap ', N ,' so : ') ;
For i := 1 To n Do
Begin
Write(' So thu ', i ,' = ') ; Readln( a[i] ) ;
End ;
For i := 1 To n-1 Do
Repeat
d := a[i] ;
a[i] := a[ i+1 ] mod a[i] ;
a[i+1] := d ;
Until a[i] = 0 ;
Writeln (' USCLN cua ', N ,' so la : ', a[n] ) ;

Readln ;
END .
BÀI TẬP CHƯƠNG 3


B i 1à :
Dùng thủ tục chuyển một số tự nhiên n cho trước sang hệ cơ số 2 .
Procedure Change ( n : integer ; Var St : String ) ;
(* thủ tục chuyển số tự nhiên n cho trước sang
hệ cơ số 2 và được lưu ở trong xâu St *)
Type
b : Array[0 1] Of Char = ('0' , '1') ;
Var
du , So : Integer ;
S : String ;
Begin
S := '' ; (* xâu rỗng *)
So := n ;
Repeat
Du := So mod 2 ;
So :=So div 2 ;
S := b[du] + s ;
Until So = 0 ;
St := S ;
End ;
B i 2à :
Dùng thủ tục giải phương trình bậc hai ax
2
+ bx + c = 0
Uses Crt ;

Var a, b, c, x1, x2: real;
(*================================*)
Procedure Nhapabc(var aa,bb,cc: real);
Begin
Write('a='); Readln(aa);
Write('b='); Readln(bb);
Write('c='); Readln(cc);
End;
(*=================================*)
Procedure GPTB2;
Var Delta: real;
Begin
Delta:=sqr(b)-4*a*c;
If Delta<0 then Writeln('Phuong trinh vo nghiem.')
Else
If Delta=0 then
Begin
Write('Phuong trinh co nghiem kep : ');
Write('x1,2=',-b/(2*a):8:2);
End
Else
Begin
x1:=(-b+sqrt(Delta))/(2*a);
x2:=(-b-sqrt(Delta))/(2*a);
Writeln('Phuong trinh co 2 nghiem phan biet la :');
Writeln('X1=',x1:8:2, 'X2=',x2:8:2);
End;
End;
(*================================*)
BEGIN (* CT chính *)

Clrscr;
Writeln(' Giai Phuong Trinh Bac Hai Voi Cac He So :');
Nhapabc(a,b,c);
If a<>0 then GPTB2
Else Writeln(' Khong phai phuong trinh bac hai ');
Readln ;
END .
B i 3à :
Hãy viết lại thủ tục Insert đối với một chuỗi kí tự cho trước tùy ý .
Procedure Insert ( St1 : String ; Var St2 : String ;Vt : Byte ) ;
(* chèn xâu St1 vào St2 bắt đầu từ vò trí Vt *)
Var i : Byte ;
S : String ;
Begin
If ( Vt > length(St2) Or ( Vt < 1 ) Then
Write(' Khong the chen ra ngoai xau ') ;
Else
Begin
S := '' ; (* xâu rỗng *)
For i := 1 To (Vt - 1) Do S := S + St2[i] ;
S := S + St1 ;
For i := Vt To length(St2) Do S := S + St2[i] ;
St2 := S ;
End ;
End ;
B i 4à :
Viết chương trình thực hiện lần lượt các cơng việc sau :
_ Lập thủ tục nhập ba số thực dương a , b , c từ bàn phím .
_ Lập thủ tục kiểm tra xem ba số trên có lập thành ba cạnh của tam giác
hay khơng ?

_ Viết thủ tục tính diện tích của tam giác .
_ Viết thủ tục tính các trung tuyến của tam giác .
_ Viết hồn thiện chương trình chính .
Uses Crt;
Var a, b, c: real ;
(*================================*)
Procedure Nhap(Var a, b, c: real);
Procedure input (Var a: real; tenbien: Char);
Begin
Repeat
Write('Nhap ' + tenbien+' = '); Readln(a);
Until (a>=0);
End;
Begin (* bắt đầu thủ tục nhập *)
Input(a, 'a');
Input(b, 'b');
Input(c, 'c');
End; (* kết thúc thủ tục nhập *)
(*================================*)
Procedure Kiemtra(a, b, c: Real);
Begin
If (a<b+c) and (b<a+c) and (c<a+b) then
Writeln(a:0:2, ', ', b:0:2, ' va ', c:0:2,
' lap thanh ba canh cua tam giac ')
Else Writeln('Khong lap thanh ba canh cua tam giac') ;
End;
(*===============================*)
Procedure Trung_tuyen (a, b, c: Real);
Var ma, mb, mc: real;
Begin

ma:=sqrt((2*sqr(b)+2*sqr(c)-sqr(a))/4);
mb:=sqrt((2*sqr(a)+2*sqr(c)-sqr(b))/4);
mc:=sqrt((2*sqr(a)+2*sqr(b)-sqr(c))/4);
Writeln('Cac trung tuyen cua tam giac la : ') ;
Writeln('ma=', ma:0:2, ' mb=', mb:0:2, ' mc=', mc:0:2);
End;
(*================================*)
Procedure Dientich (a, b, c: real); Var p, S: real;
Begin
p:=(a+b+c)/2;
S:=sqrt(p*(p-a)*(p-b)*(p-c));
Writeln('Dien tich =', S:0:2);
End;
(*================================*)
BEGIN (* Chöông trình chính *)
Clrscr;
Nhap(a, b, c);
Kiemtra(a, b, c);
Dientich(a, b, c);
Trung_tuyen(a, b, c);
Readln;
END .
B i 5à :
Giải phương trình x + y + z = 12 trong phạm vi số nguyên không âm với điều
kiện x < 4 .
Uses Crt;
Var X, Y, Z: byte;
Begin
Clrscr;
Writeln('Giai phuong trinh X+Y+Z=12 trong pham vi '

+ 'so nguyen khong am voi dieu kien x<4');
For X:=0 to 3 do
For Y:=0 to 12 do
For Z:=0 to 12 do
If (X+Y+Z=12) then Writeln(' x=',X,' y=',Y, 'z=',Z);
Readln;
End.
B i 6à :
Cho trước các số N , a , b , c tự nhiên . Giải phương trình sau trong phạm vi số
nguyên không âm x + y + z = N với điều kiện x < a , y < b , z < c .
Uses Crt;
Var N, a, b, c, X, Y, Z, i: Integer;
Begin
Clrscr;
Write(' N, a, b, c = '); Readln(N, a, b,c);
If (a+b+c-3<N) then
Begin
Writeln('Phuong trinh vo nghiem'); Readln;
Exit;
End
Else
Begin
Writeln('Phuong trinh co nghiem la:');
Writeln('x': 10, 'y': 10, 'z':10);
i:=4;
For X:=0 to (a-1) do
For Y:=0 to (b-1) do
For Z:=0 to (c-1) do
If (X+Y+Z=N) then
Begin

Writeln(x: 10, y: 10, z: 10);
inc(i);
If i=24 then
Begin
Write('Nhan Enter de tiep tuc '); Readln;
i :=0;
End;
End ;
End ;
Write('Nhan Enter de ket thuc ');
Readln;
End.
B i 7à :
Viết thủ tục Compare ( S1 , S2 : String ; Var Kq : String ) thực hiện cơng
việc sau : so sánh hai xâu S1 và S2 , tìm tất cả các kí tự có trong cả hai xâu
trên . Xâu Kq sẽ chứa tất cả các kí tự đó , mỗi kí tự chỉ được nhớ một lần .
Uses Crt;
Var xau1,xau2,xau: string;
(*==================================*)
Procedure compare(s1, s2: string; Var kq: string);
Var i: byte;
(*===============================*)
Function kt(ch: char; st: string): boolean;
(* Kiểm tra xem kí tự Ch có trong xâu St không . Nếu có thì
hàm trả về giá trò True . Nếu không thì hàm trả về giá trò
False *)
Begin
kt:=pos(ch,st)<>0;
End;
(*================================*)

Begin (* Thân của thủ tục Compare*)
kq:=''; (* Xâu rỗng *)
For i:=1 to length(s1) do
If (not kt(s1[i],kq)) and (kt(s1[i],s2)) then
kq:=concat(kq,s1[i]);
End;
(*==============================*)
BEGIN
Clrscr;
Writeln('Nhap 2 xau S1 va S2 :');
Write('S1: '); Readln(xau1);
Write('S2: '); Readln(xau2);
Compare(xau1, xau2, xau);
If xau<>'' then Writeln('Xau chung la: ',xau)
Else Writeln('Khong co ki tu nao trong ca hai xau ');
Write('Nhan ENTER de ket thuc ');
Readln;
END .
B i 8à :
Viết hàm tính D (St1 , St2) , với U, V là hai xâu kí tự bất kì , là tổng số các kí tự
khơng giống nhau trong hai xâu trên , mỗi loại kí tự chỉ được nhớ một lần . Ví
dụ D (‘aabba’ , ‘bcdd’) = 2 vì chỉ có hai kí tự a và d là khơng giống nhau trong
các xâu trên .
Uses Crt;
Const M=100;
Var S: array[1 M] of string;
max, min, i, j, n: byte;
(*===============================*)
Function D(U,V: string): byte;
(*Trả về tổng số loại kí tự không giống nhau

trong 2 xâu U và V *)
Var k, id: byte;
s, luu: string;
Begin
luu:=''; (* Xâu rỗng *)
For id:=1 to length(U) do
If (pos(U[id],V)=0) and (pos(U[id],luu)=0) then
luu:=concat(luu,U[id]);
For id:=1 to length(V) do
If(pos(V[id],U) = 0) and (pos(V[id],luu)=0) then
luu:= concat(luu,V[id]);
d:=length(luu);
End;
(*=================================*)
Procedure nhap;
Begin
Repeat
Write('So xau ki tu (>=2):') ; Readln(n);
If n<2 then
Writeln(#7,'Co ',n,' xau ki tu nen khong the '
+ 'so sanh duoc');
Until n>=2;
Writeln('Nhap ',n,' xau ki tu :');
For i:=1 to n do
Begin
Write('S',i,'='); Readln(S[i]);
End;
End ;
(*===============================*)
BEGIN (* Chương trình chính *)

Clrscr;
nhap;
max:=0;
min:=255;
For i:=1 to n-1 do
For j:=i+1 to n do
Begin
If max<d(S[i],S[j]) then max:=d(S[i],S[j]);
If min>d(S[i],S[j]) then min:=d(S[i],S[j]);
End;
Write('Max(d(Si,Sj)=',max,' Min(d(Si,Sj)=',min);
Readln;
END .
B i 9à :
Viết chương trình hoàn chỉnh thực hiện các công việc của thực đơn sau :
1. 1. Nhập dữ liệu ( nhập số tự nhiên n ) .
2. 2. Phân tích ra thừa số nguyên tố ( phân tích n thành tích các số
nguyên tố ) .
3. 3. Thoát khỏi chương trình .
Uses Crt;
Type uoc_nguyen_to=array[1 50] of longint;
Var
u, N: longint;
i, dem: integer;
a: uoc_nguyen_to;
(*================================*)
Procedure nhap(Var NN:longint);
Begin
Repeat
Write('Nhap N='); Readln(NN);

Until NN>=0;
End;
(*=================================*)
Procedure viet;
Begin
If dem=0 then
Writeln('So ',N,' khong the phan tich thanh '
+ 'tich cua cac so nguyen to')
Else
If dem=1 then Writeln(N, '=', a[dem])
Else
Begin
Write(N,'=');
For i:=1 to dem-1 do Write(a[i],'*');
Writeln(a[dem]);
End;
End;
(*================================*)
Procedure phantich(N1:longint);
Begin
If N1>1 then
Begin
u:=2;
dem:=0;
Repeat
If (N1 mod u=0) then
Begin
inc(dem);
a[dem]:=u;
N1:=N1 div u;

End
Else inc(u);
Until N1=1;
End
Else dem:=0;
Viet;
End;
(*==============================*)
BEGIN (* Main Program *)
Clrscr;
Writeln('Phan tich so N thanh tich cua cac so nguyen to :');
nhap(N);
phantich(N);
Write('Nhan Enter de ket thuc ');
Readln;
END .
BÀI TẬP CHƯƠNG 4


B i 1à :
Giải hệ phương trình tuyến tính hai ẩn dùng ma trận :
a
11
x + a
12
y = c
1
a
21
x + a

22
y = c
2
Uses Crt;
Var a: array[1 2, 1 2] of real;
c: array[1 2] of real;
d, dx, dy, x, y: real;
BEGIN
Clrscr;
Writeln('Giai he phuong tring tuyen tinh hai an:');
Writeln(' a11x+a12y=c1');
Writeln(' a21x+a22y=c2');
Writeln('Nhap cac he so cua he phuong trinh');
Write('a11='); Readln(a[1,1]);
Write('a12='); Readln(a[1,2]);
Write('c1='); Readln(c[1]);
Write('a21='); Readln(a[2,1]);
Write('a22='); Readln(a[2,2]);
Write('c2='); Readln(c[2]);
d:=a[1,1]*a[2,2] - a[2,1] * a[1,2];
dx:=c[1]*a[2,2] - c[2] * a[1,2];
dy:=a[1,1]*c[2] - a[2,1] * c[1];
If d=0 then Writeln(' He vo nghiem hoac vo so nghiem')
Else
Begin
x:=dx/d; y:=dy/d;
Writeln('He co nghiem duy nhat :');
Writeln('x=', x:0:2, ' ; y=', y:0:2);
End ;
Readln;

END .
B i 2à :
Lập phương trình tạo ra một mảng chứa bảng cửu chương .
Uses Crt ;
Var a : Array[1 10, 2 9] Of Byte ;
i, j : Byte ;
BEGIN
Clrscr ;
For i := 1 To 10 Do
For j := 2 To 9 Do a[i, j] := i*j ;
Writeln(' Bang cuu chuong : ') ; Writeln ;
For i := 1 To 10 Do
For j := 2 to 9 do Write ( j:4 , 'x' , i:2 , '=' , a[i , j]:2)
;
(* hết 80 cột tự động xuống hàng *)
Readln ;
END .
B i 3à :
Viết chương trình nhập hai số ngun dương m , n . Sau đó tính trung bình
cộng bình phương các số ngun từ m đến n .
Var m , n , k , s : Word ;
tb : real ;

BEGIN
Writeln('Nhap 2 so nguyen duong m, n :') ;
Write (' m = ') ; Readln(m) ;
Write (' n = ') ; Readln(n);
If m > n Then (* đỗi chỗ để m <= n *)
Begin
k := m ; m := n ; n := k ;

End ;
s := 0 ;
For k := m To n do s := s + sqr(k) ;
tb := s / (n - m + 1) ;
Writeln ('Trung binh cong bimh phuong cac so '
+ 'nguyen tu m den n la: ', tb:12:2);
Readln ;
END .
B i 4à :
Viết chương trình nhập từ bàn phím các phần tử của một mảng hai chiều . Kích
thước của mảng được nhập trước từ bàn phím .
Var m , n , i , j : Byte ;
a : Array[1 100, 1 100] Of Real;
BEGIN
Write ('Nhap cac kich thuoc cua mang hai chieu : ') ;
Write (' So hang m = ') ; Readln(m) ;
Write (' So cot n = ') ; Readln(n) ;
Writeln (' Nhap cac phan tu cua mang : ') ;
For i := 1 To m Do
For j := 1 To n Do
Begin
Write ('a[', i:2, ', ' , j:2 ,']=') ; Readln(a[i, j]) ;
End ;
Readln ;
END .
B i 5à :
Dãy số sau được gọi là dãy Fibonaci :
a
1
= 1

a
2
= 1
a
3
= 2
a
4
= 3
. . .
a
n
= a
n-1
+ a
n-2

Viết chương trình tính 20 số Fibonaci đầu tiên và đưa ra kết quả vào một
mảng 20 phần tử .
Var
a : Array[1 20] Of Byte ;
i : Byte ;
BEGIN
a[1] :=1;
a[2] :=1;
For i:=3 to 20 do a[i]:=a[i-1]+a[i-2] ;
END .
B i 6à :
Dãy số a
n

được định nghĩa như sau :
a
1
= 1
a
2
= 2
. . .
a
n
= 2a
n-1
+ a
n-2
( n > 2 )
Hãy lập chương trình tính và gán giá trị của dãy vào biến mảng .
Var a : Array [1 100] Of Word ;
i, N : Byte ;
S : Real ;
BEGIN
Write (' Nhap so N>=2 : ') ; Readln(n) ;
a[1] := 1 ;
a[2] := 2 ;
For i := 3 To N Do a[i] := 2*a[i-1]+a[i-2] ;
S := 0 ;
For i := 1 to N do S := S+1/sqr(a[i]) ;
Writeln (' S = ', S:12:6) ;
Readln ;
END .
B i 7à :

Nhập số tự nhiên N và viết chương trình tạo mảng bao gồm N số nguyên tố đầu tiên
.
var
a:array[1 100,1 100]of byte;
n,i,j,k,l,ba:byte;
d:boolean;
BEGIN
write(' Nhap kich thuoc cua mang hai chieu NxN. N = ');readln(n);
for i:=1 to n do
for j:=1 to n do
begin
ba:=0;
repeat
d:=FALSE;
if j>1 then for k:=1 to j-1 do
if a[i,k]=ba then d:=true;
if i>1 then for k:=1 to i-1 do
if a[k,j]=ba then d:=true;
ba:=ba+1;
until not d;
a[i,j]:=ba-1;
end;
for i:=1 to n do
for j:=1 to n do write(a[i,j]:8);
readln;
END .
B i 8à :
Viết chương trình nhập một bảng số 3 x 3 với điều kiện các số được nhập sẽ
hiện trên màn hình đúng tại vị trí của mình trên bảng số .
Uses Crt;

Var
a : array[1 3, 1 3] of integer ;
i, j: byte ;
BEGIN
Clrscr;
Writeln('Nhap mot bang so nguyen kich thuoc 3x3:');
Gotoxy(10, 4); Write(1);
Gotoxy(19, 4); Write(2);
Gotoxy(28, 4); Write(3);
Gotoxy(5, 6); Write(1);
Gotoxy(5, 8); Write(2);
Gotoxy(5,10); Write(3);
For i:=1 to 3 do
For j:=1 to 3 do
Begin
Gotoxy(9*j-1, 2*i+4); Read(a[i, j]);
Gotoxy(9*j-1, 2*i+4); ClrEol; Write(a[i, j]:6);
End;
Readln;
END .
B i 9à :
a. a. Viết chương trình nhập dữ liệu từ dãy đối xứng vào mảng một chiều .
b. b. Viết chương trình nhập dữ liệu là ma trận đối xứng vào mảng hai chiều
.
a)
Var a: array [1 100] of integer;
n, i: byte;
Begin
Write('Nhap so phan tu cua day doi xung:');
Readln(n);

Writeln('Nhap cac phan tu cua day:');
For i:=1 to (n+1) div 2 do
Begin
Write('a[', i:2, ']='); Readln(a[i]);
a[n-i+1] := a[i];
End;
Readln ;
END ;
b)
Var a: array [1 100, 1 100] of integer;
n, i, j: integer;
BEGIN
Write('Nhap kich thuoc cua mang doi xung: ');
Readln(n);
Write('Nhap cac phan tu cua mang:');
For i:=1 to n do
For j:=1 to i do
Begin
Write('a[', i:2, ',', j:2, ']='); Readln(a[i, j]);
a[j,i]:=a[i,j];
End;
Readln ;
END ;
BÀI TẬP CHƯƠNG 5


B i 1à :
Lập trình đếm số lần xuất hiện ở mỗi loại kí tự thuộc bảng chữ cái tiếng Anh
trong một xâu kí tự Str .
Var A: array [ 'A' 'Z'] of integer;

S: string;
ch: char;
i: integer;
BEGIN
Write(' Cho mot xau ki tu : '); Readln(s);
For ch:= 'A' to 'Z' do A[ch]:=0;
For i:=1 to length(s) do
Begin
If Upcase(S[i]) in (['A' 'Z']) then
Begin
S[i]:= Upcase(S[i]);
A[S[i]]:= A[S[i]]+1;
End;
End;
For ch:= 'A' to 'Z' do
Writeln('So lan xuat hien cua ',ch,' trong xau la: ', A[ch]:4) ;
Readln ;
END .
B i 2à :
Cho số tự nhiên n và xâu có độ dài n . Hãy biến đổi xâu đã cho bằng cách thay
đổi trong đó :
a. a. Tất cả các dấu ! bằng dấu chấm .
b. b. Mỗi một nhóm các dấu chấm liền nhau bằng một dấu chấm .
c. c. Một nhóm các dấu chấm đứng liền nhau bằng dấu ba chấm .
a )
Var S: string;
i: byte;
BEGIN
Write(' Cho mot xau ki tu S = '); Readln(S);
For i:=1 to length(S) do

If S[i] = '!' then S[i]:= '.';
Write( ' Chuoi sau khi da bien doi la : ', S);
Readln;
END .

b )
Uses crt;
Var S : string;
i : byte;
BEGIN
Clrscr;
Write(' Cho mot xau ki tu S = '); Readln(S);
i:=1;
While i< length(S) do
If (S[i]='.')and(S[i+1]='.') then Delete(S,i,1)
Else inc(i);
Write('Chuoi sau khi da bien doi la: ' ,S);
Readln;
END .

c )
Uses crt;
Var S: string;
i, j: byte;
BEGIN
Clrscr;
Write('Nhap xau S='); Readln(S);
i:=1;
While i<=Length(S) do
Begin

If S[i]='.' then
Begin
j:=i;
While (S[i]='.')and(i<=length(S)) do inc(i);
dec(i);
If (i-j)=1 then insert('.',S,i)
Else
If (i-j)>2 then
Begin
Delete(S,j+2,i-j-2); i:=j+1;
End;
End ;
Inc(i);
End;
Write('Chuoi sau khi bien doi la: ',S);
Readln;
END .
B i 3à :
Cho số tự nhiên n và một dãy các kí tự S
1
, S
2
, … , S
n
. Hãy tìm số tự nhiên I
đầu tiên sao cho các kí tự S
i
, S
i+1
đều là chữ cái a . Nếu trong dãy không có

những cặp như vậy thì thông báo .
Var S: string;
i: integer;
BEGIN
Write(' Cho mot xau ki tu : '); Readln(S);
i:= pos('aa', S); {tìm vò trí xaâu con 'aa' trong S}
If i<>0 then Writeln(' Ton tai "aa" tai vi tri ', i)
Else Writeln(' Khong ton tai .') ;
Readln;
END .
B i 4à :
Cho số tự nhiên n và dãy các kí tự S
1
, S
2
, … , S
n
. Biết rằng trong dãy có ít
nhất một dấu phẩy . Hãy tìm số tự nhiên i sao cho :
a. a. S
i
là dấu phẩy đầu tiên .
b. b. S
i
là dấu phầy cuối cùng .
a )
Var S: string;
i: integer;
BEGIN
Write('Cho mot xau S co dau ",": '); Readln(S);

i:= pos(',', S); (* vò trí cuûa daáu ',' trong S *)
If i<> 0 then Write(' Vi tri thoa man la: ', i);
Readln;
END .
b )
Var S: string;
i: integer;
BEGIN
Write('Cho mot xau S co dau ",": '); Readln(S);
i:= length(S);
While (i>=1)and(S[i] <> ',' ) do i:=i -1;
If i>=1 then Write('So thu tu thoa man la: ', i)
Else Write('Khong ton tai.');
Readln;
END .
B i 5à :
Viết chương trình nhập một xâu kí tự , sau đó chỉ ra xem xâu đó có phải là xâu
đối xứng không ( xâu đối xứng là xâu có các kí tự giống nhau và đối xứng nhau
qua điểm giữa xâu , ví dụ ‘ABBA’ hoặc ‘ABCBA’ ) .
Uses Crt;
Var St : string;
dx : Boolean;
i, len: byte;
BEGIN
Clrscr;
Write(' Nhap xau St = '); Readln(St);
dx:= True;
i:=1;
len:= Length(St);
While dx and (i<=(len div 2)) do

Begin
dx:=(St[i] = St[len - i+1]);
inc(i);
End;
If dx then Write(' St la xau doi xung ')
Else Write(' St khong phai la xau doi xung ') ;
Readln;
END .
B i 6à :
Cho một xâu kí tự S . Hãy viết chương trình tính xem trong S có bao nhiêu loại
kí tự khác nhau ( phân biệt chữ in hoa với chữ in thường ) . Ví dụ với S là
“Pascal” ta có đáp số là 5 .
Var S: string;
i, j, dem: integer;
t: boolean;
BEGIN
Write('Cho mot xau ki tu S: '); Readln(S);
dem:=0;
For i:=1 to length(S) do
Begin
t:=false;
For j:=1 to i-1 do if (S[j]=S[i]) then t:=true;
If not t then dem:= dem+1;
End;
Write('So ki tu khac nhau cua xau S la: ', Dem);
Readln;
END .
B i 7à :
Viết chương trình nhập một xâu kí tự và biến đổi chúng thành toàn chữ in hoa
Var S : string;

i : integer;
BEGIN
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 .
B i 8à :
Họ tên một học sinh được nhập từ bàn phím . Bạn hãy viết chương trình điều
chỉnh lại các kí tự đầu của các từ đơn trong tên của học sinh ấy trở thành chữ
in hhoa .
Uses crt;
Const Chu=['a' 'z'];
Var Hoten: string;
i,len: byte;
BEGIN
Clrscr;
Write('Ho ten='); Readln(Hoten);
Len:=length(Hoten);
If Hoten[1] in Chu then Hoten[1]:=Upcase(Hoten[1]);
For i:=2 to len do
If (Hoten[i-1]=#32)and(Hoten[i] in Chu) then
Hoten[i]:=Upcase(Hoten[i]);
Write('Ho ten sau khi dieu chinh la: ', Hoten);
Readln;
END .
B i 9à :
Viết chương trình nhập xãu kí tự từ bàn phím , sau đó gọt xâu lại bằng cách
cách xố đi các kí tự trống ở hai đầu của xâu . Ví dụ nếu nhập xâu “ Ha noi

“ , thì kết quả sẽ là “Ha noi” .
Var S: String;
BEGIN
Write('Cho mot xau ky tu: '); Readln(S);
While S[1] = #32 do Delete(S,1,1);
While (S[length(S)] = #32) do Delete(S,length(S),1);
Write('Chuoi sau khi da bien doi la: ', S);
Readln;
END .
BÀI TẬP CHƯƠNG 6


B i 1à :
Bạn hãy viết hàm Card(A) đếm số phần tử của tập hợp A cho trước có kiểu Set
Of 0 99 .
(* hàm đếm số phần tử của tập hợp *)
Uses Crt;
Type Tap=set of 0 99;
Const inp='Number.dat';
Var S : Tap;
i : byte;
Procedure Nhap;
Var a: byte; f: text;
Begin
S:=[];
Assign(f,inp); Reset(f);
While not SeekEoF(f) do
begin
Readln(f,a); If (a>=0)and(a<=99) then S:=S+[a];
End;

Close(f);
End;
Function Card(S: Tap): byte;
Var i,n: byte;
Begin
n:=0;
For i:=0 to 99 do If i in S then Inc(n);
Card:=n;
End;
BEGIN
Nhap;
Clrscr;
Write('Tap S co ',Card(S),' phan tu.');
Readln;
END.