Bài tập Pascal
A. BÀI TẬP VỀ CÂU LỆNH CÓ CẤU TRÚC
Bài 1. Kiểm tra số nguyên tố
Var n,I : integer; ok : boolean;
Begin
Vrite (‘nhập:’); Readln(n);
If n <= 1 then ok:= False
Else
If n = 2 then ok:= True
Else
Begin
I:= 2;
While (n mod I <> 0) and ( i<= sqrt(n));
If i > sqrt(n) then ok:= true
Else ok:= false;
End;
If ok then write (‘ Đó là số nguyên tố’)
Else write (‘ Đó không à số nguyên tố’);
Readln;
End.
Var n,I,k : integer;
Begin
Vrite (‘nhập:’); Readln(n);
I:= 2;
K:= trunc(sqrt(n));
Repeat
Inc(i);
Until (i>k) or (n mod I = 0) ;
If i > k then write (‘ Đó là số nguyên tố’)
Else write (‘ Đó không à số nguyên tố’);
Readln;
End.
Program Ktra_sngto;
Var n: word;
Funtion Ngto(k:word): Boolean;
Var i,dem:Word;
begin
dem:=0;
Ngto:=false;
for i:=2 to n do if n mod i = 0 them
dem:=dem+1;
if dem = 2 then Ngto:= true;
end;
BEGIN
Writeln('Nhap n '); readln(n);
while n <2 do
begin
writeln('nhap lai');
readln(n);
end;
if Ngto(n) then writeln(' So nguyen to')
else
writeln('Khong la so nguyen to;
End.
Sưu tầm và biên soạn: Nguyễn Minh Đức
1
Bài tập Pascal
Bài 2: Nhập 1 số tự nhiên n.Liệt kê các số nguyên tố nhỏ hơn n.
VD: n=13
Các số nguyên tố nhỏ hơn n: 2 ,3 ,5 , 7, 11
Program bt;
Var i,n,j : integer;
Begin
Write ('Nhap n:');Readln(n);
Write ('Cac so nguyen to nho hon ',n,' la:');
For i:=2 to n-1 do
Begin
j:=2;
While i mod j <>0 then
j:=j+1;
if i=j then write (i,',');
end;
readln;
End.
Bài 3:
Var n:longint;
{ }
Function ngto(n:longint):boolean;
Var i:word;
Begin
ngto:=false;
for i:=2 to trunc(sqrt(n)) do
if n mod i=0 then exit;
ngto:=true;
end;
{ }
BEGIN
write('nhap n: ');
readln(n);
for i:=2 to n do
if ngto(i) then write(i,' ');
Readln;
END.
Bài 4: tinh tổng và tích
Var i,tong,tich,n,m:longint;
Begin
write('nhap so n,m: '); readln(n,m);
tong:=0; tich:=1;
for i:=1 to m do
begin
tong:=tong+(n mod 10);
tich:=tich*(n mod 10);
n:=n div 10;
end;
writeln('tong la: ',tong);
writeln('tich la: ',tich);
Readln;
End.
Sưu tầm và biên soạn: Nguyễn Minh Đức
2
Bài tập Pascal
Bài 5 : Nhập 1 số đếm các chứ số của số nhập vào.
Var a,i,j,n:longint;
Begin
write('Nhap so n: ');readln(n);
i:=0; j:=10;
repeat
a:=n mod j;
j:=j*10;
i:=i+1;
until a=n;
write('So chu so cua n la: ',i);
readln;
End
Bài 6. Đổi kí tự thành chữ hoa
Program DoiChu;
Var St:String;
i: integer;
Begin
Write('Hãy nhập tên của bạn : '); Readln(St);
FOR i:= 1 TO Length(St) DO
St[i] := Upcase(St[i]);
(*Hàm Upcase đổi ký tự thành chữ in hoa*)
Writeln;
Writeln(St);
Readln;
End.
Bài 7 : VCT tính số tiền điện trong 1 thắng.
Var kw, SoTien:LongInt;
Begin
Write('Nhap so KW dien da su dung trong thang: ');
Readln(kw);
Case kw of
1 100: SoTien := kw*650;
101 200: SoTien :=100*650+(kw-100)*1100;
201 300: SoTien :=100*650+100*1100+(kw-200)*2000;
Else SoTien :=100*650+100*1100+100*2000+(kw-300)*3000;
End;
Writeln('So Tien phai tra trong thang la: ',SoTien);
Readln;
End
Bài 8 :Viết chương trình kiểm tra trong 3 số a,b,c nhập từ bàn phím số nào là lớn nhất.
uses crt;
var
a, b, c, max: integer;
Begin
clrscr;
write ('Nhap so a:= '); readln (a);
write ('Nhap so b:= '); readln (b);
write ('Nhap so c:= '); readln (c);
max:=a; {cái này dạng như chúng ta giả sử a là số lớn nhất :D }
if max<b then max:=b;
if max<c then max:=c;
write ('so lon nhat max:= ',max);
readln;
End.
Sưu tầm và biên soạn: Nguyễn Minh Đức
3
Bài tập Pascal
Bài 9 : Nhập 3 số bất kì kiểm tra xem nó có phải là 3 cạnh của tam giác ko
uses crt;
var
a,b,c,p,s: real;
Begin
clrscr; {Xóa màn hình}
write ('Nhap a:= ');readln (a);
write ('Nhap b:= ');readln (b);
write ('Nhap c:= ');readln (c);
if (a>0) and (b>0) and (c>0) and (a+b>c) and (b+c>a) and (a+c>b) then
begin
write ('3 cạnh tren tao thanh 1 tam giac');
if (a=b) and (b=c) then
write ('Day la tam giac deu');
if (a=b) or (b=c) or (a=c) then
weite ('Day la tam giac can');
p:= (a+b+c)/2;
s:= SQRT(p*(p-a)*(p-b)*(p-c));
write ('chu vi: ',2*p:0:5,' Dien tich: ',s:0:5);
end
else
write ('3 so nay khong tao thanh 1 tam giac');
readln;
End.
Bài 10: đếm số chữ số tạo thành 1 số nguyên
Var
m, n, dem : longint;
Begin
Write (;nhap n:’); readln(n);
Dem:= 0;
m:= n;
Repeat
n:= n div 10;
inc (dem);
Until n=0;
Writeln(‘n,’co tat ca la’,dem,’chu so’);
Readln;
End.
Bài 11 : Thông báo ra màn hình các sô k<=n bằng tổng các ước số của nó và nhỏ hơn nó.
Var
n, I, j, s : integer;
Begin
Write(‘nhap n’); readln(n);
Repeat
For I = 1 to n do
Begin
S:= 0;
For j :=1 to I div 2 do
If I mod j = 0 then s := s + j;
If s := I then write (i:j,’ ‘);
End;
Until n <= 1000 ;
Readln;
End.
Bài 12: Nhập vào một số, máy sẻ báo: chẳng hay lẻ, chính phương hay ko?
Var a: integer;
Begin
Write(‘nhap a:’); readln(a);
Sưu tầm và biên soạn: Nguyễn Minh Đức
4
Bài tập Pascal
If a mod 2 = 0 then writeln(a,’la so chan’)
Else
Writeln(a,’la so le’);
If sqrt(a) = int(sqrt(a)) then writeln(a,’la so chinh phuong’)
Else
writeln(a,’khong la so chinh phuong’);
readln;
End.
Bài 13: Tính 1 – 2
2
+ 3
2
– 4
2
+ … +n
2
Var
Write(‘nhap n’); readln(n);
S:= 0;
For i:= 1 to n do
If I mod 2 <> 0 then
S:= S + sqr(i)
Else
S:= S – sqr(i);
Writeln(‘tong la :=’,S);
Readln;
End.
Bài 14: Chuyển số thập phân thành dãy số nhị phân.
Var
n, m, I : integer;
chuso : byte; {chữ số chỉ nhận 2 giá trị: 0, 1}
Begin
Write(‘nhập n =’); readln(n);
m := 16384 = 2
14
;
write(0); {chu so dau tien la 0}
for i := 1 to n do
begin
chuso := n div m ; {chu so nhi phan dau tien}
write(chuso);
if (i+1) mod 4 = 0 then write (‘ ‘);
n := n – m*chuso;
m :=mdiv 2;
end;
readln;
End.
Bài 15: Nhập 1 số nguyên dương in ra màn hình UCLN
Var
n, m, I : integer;
Begin
Write(‘nhap n:’); readln(n);
m := 0;
for i := 1 to n do
Begin
m := n div I;
if (m mod 2 <> 0) and (m > max) them max := m;
end;
writeln(‘UCLN;,max);
readln;
End.
Bài 16: Tính lãi suất 15% tháng
Const LS = 0,015
Var
X, Y, XX : real;
Sưu tầm và biên soạn: Nguyễn Minh Đức
5
Bài tập Pascal
Begin
Write(‘nhap X, Y: ‘); readln(X,Y);
XX := X;
Month := 0;
Repeat
Month := month + 1;
XY := XX+ XX*LS;
Until XY = Y;
Writeln(‘ Tong so tien lai :’,Y – X);
Writeln(‘so thang gui:’,month);
Readln;
End.
Bài 17: VCT xác định số ngày của 1 tháng N.
Var
M: 1990 2010;
N: 1 12;
Begin
Write(‘nhap nam hien tai:’); readln(M);
Write(‘nhap thang hien tai:’); readln(N);
Case N of
1,3,5,7,8,10,12: writeln(‘co 31 ngay’);
4,6,9,11 : writeln(‘co 30 ngay’);
2 : writeln(cos 29 ngay’)
Else
Writeln(‘co 28 ngay’);
Readln;
End.
Bài 18. Lập trình tìm các số có ba chữ số với điều kiện giá trị của số đó bằng tổng lập phương các
chữ số của nó.
uses crt;
Var
a,b,c,i:integer;
Begin
clrscr;
For i:=100 to 999 do
begin
a:=i div 100;
b:=(i div 10) mod 10;
c:=i mod 10;
if a*a*a+b*b*b+c*c*c=i then
begin
Writeln('So ',i,' co gia tri bang tong lap phuong cac chu so cua no.');
end;
end;
Readln;
End.
Bài 19. Tính tổng sau (với x thực nhập từ bàn phím):
Chương trình dừng khi
Sưu tầm và biên soạn: Nguyễn Minh Đức
6
0001,0
)12(
.)1(
12
<
+
−
+
n
x
n
n
Bài tập Pascal
uses crt;
Var
i:integer;
a,b,c,x,t:real;
Procedure tinh;
begin
a:=x;b:=0;t:=x;c:=1;
While abs(c*a/(2*b+1))>=0.0001 do
begin
a:=a*x;b:=b+1;c:=c*-1;
t:=t+c*a/(2*b+1);
end;
end;
Begin
clrscr;
Write('Ban hay nhap so x:');Readln(x);
tinh;
Writeln('Ket qua la:',t:0:10);
Readln;
End.
Bài 20: Nhập vào một số tự nhiên n.Lập trình trả lời các câu hỏisau:
- n có bao nhiêu chữ số?
- Tổng các chữ số của n bằng bao nhiêu?
- Tìm chữ số đầu tiên của n.
- Giả sử trong cách biểu diễn thập phân của n có dạng sau:
akak
- 1
a
2
a
1
a
0
.
Hãy tính tổng S = ak - ak
- 1
+ ak
- 2
- + (-1)
k + 1
.a
0
- Nhập vào số m (m ≤ số chữ số của n). Hãy tính tổng m chữ số cuối
cùng của n.
uses crt;
var
i,k,m,n:longint;
s:string;
Begin
clrscr;
Repeat
Write('Ban hay nhap so thu nhien n:');Readln(n);
if n<0 then Writeln('n phai la so tu nhien.');
Until n>=0;
Str(n,s);
Writeln('So ',n,' co ',length(s),' chu so.');
k:=0;m:=0;
For i:=1 to length(s) do
begin
k:=k+(ord(s[i])-48);
if i mod 2=1 then m:=m+(ord(s[i])-48)
else m:=m-(ord(s[i])-48);
end;
Writeln('Tong cac chu so cua ',n,' la:',k,'.');
Writeln('Chu so dau tien cua ',n,' la:',s[1],'.');
Writeln('Tong S la:',m);
Repeat
Write('Ban hay nhap so m(m<=so chu so cua n):');
Readln(m);
Sưu tầm và biên soạn: Nguyễn Minh Đức
7
Bài tập Pascal
if m>length(s) then Writeln('m phai <=',length(s), '.' );
Until m<=length(s);
Delete(s,1,length(s)-m);
k:=0;
For i:=1 to length(s) do k:=k+(ord(s[i])-48);
Writeln('Tong ',m,' chu so cuoi cung cua ',n,' la:',k,'.');
Readln;
End.
Bài 21.Với giá trị x nhập từ bàn phím, hãy tính tổng sau:
cho đến khi
uses crt;
var i:integer;
a,b,x,t: real;
Procedure tinh;
begin
i:=1;
a:=x-1;b:=x+1;t:=a/(i*b);
While a/(i*b)>=0.0001 do
begin
i:=i+2;
a:=a*(x-1)*(x-1);
b:=b*(x+1)*(x+1);
t:=t+a/(i*b);
end;
end;
Begin
clrscr;
Write('Ban hay nhap so x:');Readln(x);
if x<>-1 then
begin
if x=1 then Writeln('Ket qua la:0')
else
begin
tinh;
Writeln('Ket qua la:',t:0:10);
end;
end
else
Writeln('Cac phan tu co mau la 0 nen the chia duoc.');
Readln;
End.
Bài 22.Lập trình tính tổng các số nguyên.
uses crt;
var n,i:integer;
tong:real;
Sưu tầm và biên soạn: Nguyễn Minh Đức
8
)1(.)12(
)1(
)1(.5
)1(
)1(.3
)1(
)1(
)1(
12
12
5
5
3
3
+
++
−
++
+
−
+
+
−
+
+
−
+
+
n
n
xn
x
x
x
x
x
x
x
0001,0
)1(.)12(
)1(
12
12
<
++
−
+
+
n
n
xn
x
Bài tập Pascal
t:char;
Begin
repeat
clrscr;
writeln(' CHUONG TRINH TINH TONG N SO');
writeln('S = 1 + 1/2 + 1/3 + + 1/n');
writeln;
write('Nhap so gioi han can tinh, n=');readln(n);
tong:=1;
for i:=2 to n do tong:=tong+1/i;
writeln('Ket qua, S =',tong:7:4);
writeln;
writeln('An Phim BAT KY de TIEP TUC, X de THOAT! ');
t:=readkey;
until (t='x') or(t='X');
End.
Bài 23.Lập trình đưa ra màn hình các số nguyên tố từ 1 đến 100.
uses crt;
var i,k:integer;
Function snt(var a:integer):integer;
var i,d:integer;
begin
d:=0;
for i:=2 to round(sqrt(a)) do
if (a mod i)=0 then d:=d+1;
if d=0 then snt:=1
else snt:=0;
end;
Begin
clrscr;
writeln('CHUONG TRINH IN CAC SO NGUYEN TO TU 1 DEN 100');
writeln;
k:=0;
for i:=1 to 100 do
if snt(i)<>0 then
begin
write(i:5);
k:=k+1;
if k=13 then
begin
writeln;
k:=0;
end;
end;
writeln;
writeln('An Phim Bat ky de THOAT! ');
repeat until keypressed;
end.
Bài 24.Tính biểu thức sau với x là số thực cho trước (x ≠ 0), yêu cầu kiểm tra điều kiện x nhập vào
từ bàn phím:
uses crt;
var
i:integer;
Sưu tầm và biên soạn: Nguyễn Minh Đức
9
Bài tập Pascal
x:real;
Function tinh(i:integer):real;
var
r: real;
begin
if i<256 then r:=x*x+i/tinh(i*2)
else r:=x*x+i/(x*x);
tinh:=r;
end;
Begin
clrscr;
Repeat
Write('Ban hay nhap so thuc x:');Readln(x);
if x=0 then Writeln('Ban phai nhap x khac 0.');
Until x<>0;
Write('Ket qua la:',tinh(2):0:2);
Readln;
End.
Bài 25. Số hoàn hảo
Nhập từ bàn phím một số tự nhiên N. Lập chương trình tìm tất cả các số hoàn hảo có giá trị từ 1 đến N
(nếu có). Nếu không có hãy đưa ra thông báo “Không có”. (Số hoàn hảo là một số tự nhiên thoả mãn điều
kiện: giá trị số đó bằng tổng các ước số thực sự của nó mà không kể chính số đó).
uses crt;
var
i,k,m,n,s:integer;
Begin
clrscr;
Repeat
Write('Ban hay nhap so n:');Readln(n);
Until n>=0;
For i:=2 to n do
if i mod 2=0 then
begin
m:=1;
For k:=2 to i-1 do
if i mod k=0 then m:=m+k;
if m=i then
begin
s:=s+1;
Writeln(i);
end;
end;
Writeln('Co ',s,' so hoan hao co gia tri tu 1 den ',n,'.');
Readln;
End.
Bài 26: Tính số ngày giữa 2 mốc thời gian bất kỳ:
Yêu cầu nhập vào 6 số: nd
, td
, yd
, nc
, tc
, yc là ngày tháng năm bắt đầu và ngày tháng năm cuối (
2000 < yd < yc
). Hãy tính xem giữa hai mốc thời gian đó có bao nhiêu ngày. Biết rằng: Tháng 4, 6, 9,
11 có 30 ngày.Tháng 1, 3, 5, 7, 8, 10, 12 có 31 ngày.Tháng 2 nếu năm nhuận có 29 ngày còn nếu không
nhuận thì có 28 ngày. Bốn năm có một năm nhuận, biết rằng năm 2000 thì năm nhuận.
Sưu tầm và biên soạn: Nguyễn Minh Đức
10
Bài tập Pascal
uses crt;
var i, k, m, n, nd, td, yd, nc, tc,yc : integer;
Function ng(t,n:integer):integer;
Var a:integer;
begin
Case t of
4,6,9,11:a:=30;
1,3,5,7,8,10,12:a:=31;
2:if n mod 4<>0 then a:=28 else a:=29;
end;
ng:=a;
end;
Begin
clrscr;
Writeln('Ban hay nhap ngay thang nam bat dau:');
Write('Ngay:');Readln(nd);
Write('Thang:');Readln(td);
Write('Nam:');Readln(yd);
Writeln('Ban hay nhap ngay thang nam cuoi:');
Write('Ngay:');Readln(nc);
Write('Thang:');Readln(tc);
Write('Nam:');Readln(yc);
n:=0;
if yd<>yc then
begin
For i:=yd+1 to yc-1 do
if i mod 4<>0 then n:=n+365 else n:=n+366;
For i:=td to 12 do n:=n+ng(i,yd);
n:=n-nd;
For i:=1 to tc-1 do n:=n+ng(i,yc);
n:=n+nc;
end;
Writeln('Giua hai moc thoi gian do co ',n,' ngay.');
Readln;
End.
Bài 27: Trên một bàn cờ có n x n ô, hãy lập trình xếp 2n quân cờ lên bàn cờ sao cho không có quá 2 quân
cờ trên 1 hàng và trên 1 cột. Chỉ cần in ra một cách xếp lên màn hình (dùng dấu ‘*’làm ký hiệu quân cờ ).
var i,k,n:integer;
Begin
clrscr;
Write('Ban hay nhap so n:');Readln(n);
For k:=1 to n do
begin
For i:=1 to n do
if (i in [k,k+1]) or ((k=n) and (i=1)) then Write('*')
else Write('-');
Writeln;
end;
Readln;
End.
B. BÀI TẬP VỀ MẢNG
Bài 1: Cho mãng gồm n phần tử là số thực.
a.Tìm hai phần tử liên tiếp nhau có tổng bằng n.
b. Tính khoảng cáhc giữa hai vị trí của phần tửlớn nhất và bé nhất đầu tiên trên A.
Var
A: array[1 100] of real;
Sưu tầm và biên soạn: Nguyễn Minh Đức
11
Bài tập Pascal
Max, min : real; I, n, Vtmax, Vtmin : integer;
Begin
Writeln(‘nhap n:’); readln(n);
For i:= 1 to n do
Begin
Write(‘[‘,I,’]=’); readln(A[i]);
End;
i:=1;
{Tìm hai phần tử liên tiếp nhau có tổng bằng n}
While (A[i] + A[i+1]) <> n) and (i<= n-1) do Inc(i);
If i>=n then write (‘hai phan tu co chi so la:’,i,’ va’,i+1);
{Tính khoảng cáhc giữa hai vị trí của phần tử lớn nhất và bé nhất đầu tiên trên A}
Max:=A[1];
Min:=A[1];
For i:=1 to n do
If max < A[i] then
Begin
Vtmax:= i; Max:=A[i];
End;
If min > A[i] then
Begin
Vtmin:= i; Min:=A[i];
End;
Writeln (‘khoangr cachs giua 2 phan tu max vaf min la:’,abc(Vtmax – Vtmin);
Readln;
End.
Bai 2:
const NMax = 50;
Type Mass = array[1 NMax, 0 NMax-1] of real;
Var A: Mass; i, j, N:byte; C: real;
Begin
write ('Nhap N='); readln(N);
for i:= 1 to N do
for j:= 0 to N-1 do
begin
write('A[',i,',',j,']= '); readln(A[i,j]);
end;
for i:= 1 to N do
for j:= 0 to N-1 do
begin
C:= A[i,j];
A[i,j]:= A[N-i+1,j];
A[N-j+1,j]:= C;
end;
for i:= 1 to N do
begin
for j:= 0 to N-1 do write (A[i,j]:5:2,' ');
writeln;
end;
End.
Bài 3 :nhập vào chương trình vào 1 mảng số nguyên, sau đó liệt kê các số dương trong mảng rồi in
ra màn hình
Program bt;
Var a:array [1 1000] of longint;
i,n:word;
Begin
Sưu tầm và biên soạn: Nguyễn Minh Đức
12
Bài tập Pascal
write('nhap so phan tu cua mang: '); readln(n);
for i:=1 to n do
begin
write('nhap phan tu a[',i,']: ');
readln(a[i]);
end;
write('cac phan tu duong la: ');
for i:=1 to n do
if a[i]>0 then write(a[i],' ');
readln;
End.
Bài 5: Sắp xếp một dãy số theo thứ tự từ nhỏ đến lớn
Tiến trình của bài toán:
- Giả sử chuỗi số của ta có n phần tử . Lần lượt cho chương trình đọc giá trị của các phần tử nhập được.
- Một thủ tục (Procedure) sẽ làm công việc sắp xếp như sau : đầu tiên đưa phần tử thứ nhất so sánh với
các phần tử tiếp theo, nếu nó lớn hơn phần tử so sánh thì đem đổi chổ giá trị của hai phần tử với nhau.
Sau đó tiếp tục đem phần tử thứ 2 so sánh các phần tử tiếp theo theo trình tự như vậy, và cứ như thế
cho đến phần tử thứ n - 1.
- In kết quả ra màn hình
Chương trình Pascal như sau:
(* Sắp xếp một mảng các phần tử số thực từ nhỏ đến lớn*)
VAR n, i, loc: 1 100 ;
x : ARRAY [1 100] OF real ;
temp : real ;
PROCEDURE interchange ;
(* Ðổi chỗ các phần tử mảng từ nhỏ đến lớn*)
BEGIN
FOR loc := 1 TO n-1 DO
FOR i := loc + 1 TO n DO
IF x[i] < x [loc] THEN
BEGIN
temp := x[loc] ;
x[loc] := x[i] ;
x[i] := temp ;
END ;
END ;
BEGIN
Write (' Có bao nhiêu phần tử số ? ') ; Readln (n) ;
FOR i := 1 TO n DO
BEGIN
Write ( ‘ x[ ‘, i : 3, ‘] = ? ‘ ) ; Readln( x[i] ) ;
END ;
interchange ;
Writeln ;
Writeln (' Số liệu đã sắp xếp : ') ;
Writeln ;
FOR i := 1 TO n DO
Writeln ( ‘x[ ‘, i : 3, ‘ ] = ‘, x[i] : 4 : 1 ) ;
Readln;
END.
Bài 4: viết chương trình nhập vào 1 mảng 2 chiều, gồm các số nguyên, sau đó xuất ra màn hình các
số lẻ
Program bai2;
var a:array [1 10,1 10] of longint;
i,j,m,n:byte;
Sh, tbphc, L : integer;
Sưu tầm và biên soạn: Nguyễn Minh Đức
13
Bài tập Pascal
Tccl : real;
{khai bao du lieu}
Begin
write('nhap m,n: ');
readln(m,n);
for i:=1 to m do
for j:=1 to n do
begin
write('nhap phan tu a[',i,',',j,']: ');
readln(a[i,j]);
end;
for i:=1 to m do
for j:=1 to n do
if odd(a[i,j]) then write(a[i,j],' ');
{tong so hang le}
Sh := 0;
For i := 1 to n do
For j := 1 to n do
Sh := sh + A[I,j];
Write(‘tong so hang’,sh);
{tong binh phuong cac so tren hang chan}
Tbphc := 0;
For i := 1 to n div 2 do
For j := 1 to n do
Tbphc := tbphc + sqr (A[I sh1 1,j]);
Writeln(‘tong binh phuong cac so hang chan’,tbphc);
{tinh tong can bac 2 cac cot le}
Tccl := 0;
For := 1 to n do
For j :=1 to n div 2 do
Tccl : =tccl + sqrt(A[I,j sh 1 2] – 1);
Writeln(tong can cot le’,tccl);
{co bao nhieu gia tri nam trongg 4 6}
L : = 0;
For := 1 to n do
For j :=1 to n div 2 do
If (A[I,j] > = 4) and (A[I,j] <= 6) then
Inc(L);
Writeln(so phan tu nam trong khoang 4 6 la’,L);
{tong duong cheo chinh}
Dcc := 0;
For i:=1 to m do
For j:=1 to n do
Begin
If i=j then Dcc:=dcc + A[I,j];
End;
Writeln(‘tong duong cheo chinh’,dcc);
Readln;
End.
Bài 5:
program BT;
const NMax = 50;
type Mass = array[1 NMax, 0 NMax-1] of real;
var A: Mass;
i, j, N:byte; C: real;
Sưu tầm và biên soạn: Nguyễn Minh Đức
14
Bài tập Pascal
Begin
write ('Nhap N=');readln(N);
for i:= 1 to N do
for j:= 0 to N-1 do
begin
write('A[',i,',',j,']= '); readln(A[i,j]);
end;
{Đoạn trên này để nhập vào 1 ma trận}
for i:= 1 to N do
for j:= 0 to N-1 do
begin
C:= A[i,j];
A[i,j]:= A[N-i+1,j];
A[N-j+1,j]:= C;
end;
{Đoạn này để đổi vị trí các hàng của ma trận theo kiểu hàng đầu đổi cho hàng cuối, hàng thứ 2
đổi cho hàng kế cuối}
for i:= 1 to N do
begin
for j:= 0 to N-1 do write (A[i,j]:5:2,' ');
writeln;
end;
{Còn đoạn cuối này thì để in ma trận đã được đổi vị trí các hàng ra màn hình}
readln;
end.
Bài 6: VCT đổi 1 số nguyên hệ 10 sang hệ 2.
Var
NP: array[1 16] of byte;
n, i, j : integer;
Begin
Write(‘nhao n:’); readln(n);
For i := 1 to 16 do NP[i] := 0;
i := 1;
while n <>0 do
begin
NP[i] = n mod 2;
n := n div 2;
end;
for j := I downto 1 do write (NP[j];
readln;
End.
Bài 7:
Var
A: array[1 100] of real;
I, j : byte; temp : real;
Begin
Writeln(‘nhap so phan tu cho mang::’); readln(n);
For i:= 1 to n do
Sưu tầm và biên soạn: Nguyễn Minh Đức
15
Bài tập Pascal
Begin
Write(‘[‘,i,’]=’); readln(A[i]);
End;
{sap xep tang dan}
For i := 1 to n do
For j := i + 1 to n do
If A[i] > a[j] then
Begin
Temp := A[i];
A[i] := A[j];
A[i] := temp;
End;
Writeln(‘mang do sap xep xong’);
For i := 1 to n do write (A[i]:5:3);
{chen M vao day}
Write(‘nhap gia tri M:’); readln(M);
If M >= A[i] then A[i+1] := M
Else
Begin
J :=1;
While M> A[j] do J := j + 1;
For i := n+1 downto j – 1 do
A[i] := A[i-1];
A[j] := M;
End;
Writeln(‘ket qua sau khi chen:’);
For j :=1 to n +1 do Write(A[j] : 6);
Readln;
End.
Bài 8:
Var
X: array [1 50] of integer;
I,n, max : integer; s : real;
Begin
Write(‘nhap so phan tu:’); readln(n);
S:=0;
For i:= 1 to n do
Begin
Write(‘nhap mang X[‘,1,’]=’); readln(X[i]);
End;
{ tinh tong binh phuong cac so am trong day }
If A[i] < 0 then S:= S + sqr(X[i]);
Writeln(‘tong la:’,S:5);
{ Tim so lon nhat}
Max := 1;
if X[i] . max then max := X[i];
writeln(‘so lon nhat la:’, max);
{ tim phan tu dau tien chia het cho 10}
Ok:= false;
I := 1;
While (not ok) and (I <=n) do
If X[i] mod 10 = 0 then ok := true
Else
I:= i+1;
Sưu tầm và biên soạn: Nguyễn Minh Đức
16
Bài tập Pascal
If ok then write(‘so thu’,I,’ la:’,X[i])
Else
Write(‘khong tim thay’);
Readln;
End.
Bài 9:Cho dãy số thực bất kỳ, hãy kiểm tra xem dãy số đã sắp xếp chưa? Nếu sắp xếp rồi thì theo chiều
nào? Nếu chưa thì sắp xếp theo chiều tăng dần.
uses crt;
Var
a:array [1 1000] of real;
i,k,n:integer;
m:real;
Begin
clrscr;
Write('Ban hay nhap so phan tu cua day:');Readln(n);
For i:=1 to n do
begin
Write('Ban hay nhap so thu ',i,':');Readln(a[i]);
if (i>1) and (k<>3) then
begin
if (a[i]>a[i-1]) and (k<>1) then
if k=0 then k:=1 else k:=3;
if (a[i]<a[i-1]) and (k<>2) then
if k=0 then k:=2 else k:=3;
end;
end;
Case k of
1:Writeln('Day duoc sap xep theo thu tu tang dan.');
2:Writeln('Day duoc sap xep theo thu tu giam dan.');
3:begin
Writeln('Day chua duoc sap xep.');
Writeln('Sap xep lai theo thu tu tang dan:');
For k:=1 to n-1 do
For i:=1 to n do
if a[k]<a[i] then
begin
m:=a[i];a[i]:=a[k];a[k]:=m;
end;
For i:=1 to n do
Write(a[i]:0:2,' ');
end;
end;
Readln;
End.
Bài 10: Nhập vào một dãy các số nguyên bất kỳ, in ra màn hình các số khác nhau trong dãy số đó.
uses crt;
var a:array [1 1000] of longint;
i,k,m,n:longint;
Begin
clrscr;
Repeat
Sưu tầm và biên soạn: Nguyễn Minh Đức
17
Bài tập Pascal
Write('Ban hay nhap so phan tu cua day:');Readln(n);
if n<=0 then Write('Ban phai nhap so>0.');
Until n>0;
For i:=1 to n do
begin
Write('Ban hay nhap so thu ',i,':');Readln(a[i]);
end;
Writeln('Cac so khac nhau trong day la:');
For i:=1 to n do
begin
m:=0;
For k:=1 to i-1 do
if a[i]=a[k] then
begin m:=1;break;end;
if m=0 then Write(a[i],' ');
end;
Readln;
End.
Bài 11.Viết chương trình nhập vào một ma trận vuông k hàng, k cột. Sau đó sắp xếp lại sao cho phần tử
có trị tuyệt đối lớn nhất trong mỗi hàng sẽ nằm trên đường chéo chính.
uses crt;
var
a:array [1 100,1 100] of integer;
i,k,m,n:longint;
Begin
Repeat
Write('Ban hay nhap so k(hang,cot:');Readln(n);
if n<=0 then Write('Ban phai nhap so>0.');
Until n>0;
For k:=1 to n do
For i:=1 to n do
Begin
Write(‘nhap a[',i,',',k,']:'); Readln(a[i,k]);
end;
For k:=1 to n do
begin
m:=1;
For i:=2 to n do if abs(a[m,k])<abs(a[i,k]) then m:=i;
i:=a[m,k];a[m,k]:=a[k,k];a[k,k]:=i;
end;
clrscr;
For k:=1 to n do
For i:=1 to n do
begin
if i=k then Textcolor(14) else Textcolor(7);
Gotoxy(i*4,k);Write(a[i,k]);
end;
Readln;
End.
Bài 12. Viết chương trình nhập vào một dãy n số nguyên và in ra màn hình các thông tin sau (Nếu không
có số nào thoả mãn thì đưa ra thông báo không có):
- Số hạng âm lớn nhất của dãy và chỉ số của nó;
- Số hạng dương nhỏ nhất của dãy và chỉ số của nó;
- Số lượng số hạng dương liên tiếp nhiều nhất;
- Số lượng số hạng âm liên tiếp có tổng lớn nhất;
Sưu tầm và biên soạn: Nguyễn Minh Đức
18
Bài tập Pascal
- Số lượng số hạng liên tiếp đan dấu nhiều nhất.
uses crt;
Var a:array [1 1000] of longint;
kq:array [1 5] of integer;
i,k,n,d1,d2,d3:integer;
Begin
clrscr;
Repeat
Write('Ban hay nhap so phan tu cua day:');Readln(n);
if n<=0 then Writeln('Ban phai nhap so lon hon 0.');
Until n>0;
For i:=1 to n do
begin
Write('Ban hay nhap so thu ',i,':');Readln(a[i]);
if ((a[i]>a[kq[1]]) or (kq[1]=0)) and (a[i]<0) then kq[1]:=i;
if ((a[i]<a[kq[2]]) or (kq[2]=0)) and (a[i]>0) then kq[2]:=i;
if (a[i]>0) and (a[i-1]>0) and (i>1) then
begin
if d1=0 then d1:=2 else d1:=d1+1;
end
else begin
if kq[3]<d1 then kq[3]:=d1;d1:=0;
end;
if (a[i]<0) and (a[i-1]<0) and (i>1) then
begin if d2=0 then d2:=2 else d2:=d2+1;end
else
begin if kq[4]<d2 then kq[4]:=d2;d2:=0;end;
if (a[i]*a[i-1]<0) and (i>1) then
begin if d3=0 then d3:=2 else d3:=d3+1;end
else begin
if kq[5]<d3 then kq[5]:=d3;
kq[5]:=d3;d3:=0;
end;
end;
if kq[3]<d1 then kq[3]:=d1;
if kq[4]<d2 then kq[4]:=d2;
if kq[5]<d3 then kq[5]:=d3;
if kq[1]<>0 then Writeln('So hang am lon nhat la so thu ',kq[1],':',a[kq[1]],'.')
else Writeln('Khong co so am nao trong day.');
if kq[2]<>0 then Writeln('So hang duong nho nhat la so thu ',kq[2],':',a[kq[2]],'.')
else Writeln('Khong co so duong nao trong day.');
if kq[3]<>0 then Writeln('So luong cac so duong lien tiep lon nhat la:',kq[3],'.')
else Writeln('Khong co cac so duong nao lien tiep trong day.');
if kq[4]<>0 then Writeln('So luong cac so am lien tiep lon nhat la:',kq[4],'.')
else Writeln('Khong co cac so am nao lien tiep trong day.');
if kq[5]<>0 then Writeln('So luong cac so dan dau lien tiep lon nhat la:',kq[5],'.')
else Writeln('Khong co cac so dan dau nhau nao lien tiep trong day.');
Readln;
End.
Bài 13.Điền các số từ 1 đến nxn theo chiều kim đồng hồ vào mảng hai chiều. In mảng kết quả ra màn
hình theo dạng n dòng và n cột.
uses crt;
var a:array [1 100,1 100] of integer;
i,k,m,n,c1,c2,c3,c4:integer;
Begin
clrscr;
Sưu tầm và biên soạn: Nguyễn Minh Đức
19
Bài tập Pascal
Repeat
Write('Ban hay nhap so n:');Readln(n);
if n<=0 then Writeln('Ban phai nhap so lon hon 0.');
Until n>0;
clrscr;
m:=0;
c1:=1;c2:=1;c3:=n;c4:=n;
Repeat
For i:=c1 to c3 do
begin
m:=m+1;
a[i,c2]:=m;
Gotoxy(i*3,c2);Write(a[i,c2]);
end;
c2:=c2+1;
For i:=c2 to c4 do
begin
m:=m+1;
a[c3,i]:=m;
Gotoxy(c3*3,i);Write(a[c3,i]);
end;
c3:=c3-1;
For i:=c3 downto c1 do
begin
m:=m+1;
a[i,c4]:=m;
Gotoxy(i*3,c4);Write(a[i,c4]);
end;
c4:=c4-1;
For i:=c4 downto c2 do
begin
m:=m+1;
a[c1,i]:=m;
Gotoxy(c1*3,i);Write(a[c1,i]);
end;
c1:=c1+1;
Until m>=n*n;
Readln;
End.
Bài 14.Lập trình đưa ra màn hình bảng cửu chương có dạng:
uses crt;
type m = array [1 20,1 20] of integer;
var a,b:m;
h,c:integer;
procedure in1(var b:m;u:integer;v:integer);
var i,j:integer;
Sưu tầm và biên soạn: Nguyễn Minh Đức
20
Bài tập Pascal
tg:integer;
begin
for j:=1 to v do b[1,j]:=j;
for i:=1 to u do b[i,1]:=i;
for i:=2 to u do
for j:=2 to v do
begin
tg:=i*b[1,j];
b[i,j]:=tg;
end;
end;
procedure in2(var b:m;u:integer;v:integer);
var i,j:integer;
begin
for j:=1 to v do b[1,j]:=j;
for i:=1 to u do b[i,1]:=i;
for j:=2 to v do
for i:=2 to u do
b[i,j]:=b[i-1,j]+j;
end;
procedure hienthi(var b:m;u:integer;v:integer);
var i,j:integer;
begin
for i:=1 to u do
begin
for j:=1 to v do write(b[i,j]:5)
writeln;
end;
end;
Begin
clrscr;
h:=9; c:=9;
writeln(' IN BANG CUU CHUONG');
in1(a,h,c);
writeln('Cach 1:');
hienthi(a,h,c);
writeln;
writeln('Cach 2:');
in2(a,h,c);
hienthi(a,h,c);
writeln;
write('An Phim Bat ky de THOAT! ');
repeat until keypressed;
End.
Bài 15: Nhập vào hai số tự nhiên n và m. Hãy in ra chu kỳ của phân số n/m
Ví dụ: 1/7 có chu kỳ là (142857).
Còn các phân số hữu hạn thì chu kỳ bằng 0.
uses crt;
var
a:array [1 1000,1 2] of longint;
i,k,m,n,t,p:longint;
ck:string;
Function ucln(m,n:longint):longint;
begin
While m<>n do
begin
Sưu tầm và biên soạn: Nguyễn Minh Đức
21
Bài tập Pascal
if m<n then n:=n-m;
if m>n then m:=m-n;
end;
ucln:=m;
end;
Procedure tinh(m,n:longint);
begin
While n>m do n:=n-m;
k:=ucln(m,n);n:=n div k;m:=m div k;
i:=0;t:=0;
n:=n*10;
Repeat
i:=i+1;
a[i,1]:=n div m;
a[i,2]:=n;
if n mod m=0 then t:=2;
n:=(n mod m)*10;
For k:=1 to i-1 do
if (a[k,1]=a[i,1]) and (a[k,2]=a[i,2]) then
begin
p:=k;t:=1;Break;
end;
Until (t<>0) or (i>1000);
if t=1 then For k:=t to i-1 do ck:=ck+chr(a[k,1]+48)
else ck:='0';
end;
Begin
clrscr;
Repeat
Write('Ban hay nhap so tu nhien n:');Readln(n);
Write('Ban hay nhap so tu nhien m:');Readln(m);
if n*m<0 then Writeln('Ban phai nhap 2 so tu nhien.');
if m=0 then Writeln('m phai khac 0.');
Until (n*m>=0) and (m<>0);
if n mod m=0 then ck:='0'
else tinh(m,n);
Writeln(n,'/',m,' co chu ky = ',ck);
Readln;
End.
Bài 16: Cho số tự nhiên n và dãy các số thực a
1
, a
2
, an, trong đó hãy xác định số lượng các phần tử kề
nhau mà:
a. Cả hai số đều dương.
b. Cả hai số đều cùng dấu đồng thời số đứng trước có giá trị tuyệt đối lớn hơn số đứng sau.
c. Cả hai số trái dấu nhau.
uses crt;
var
a:array [1 1000] of longint;
kq:array [1 3] of integer;
i,n:integer;
Begin
Sưu tầm và biên soạn: Nguyễn Minh Đức
22
Bài tập Pascal
clrscr;
Repeat
Write('Ban hay nhap so phan tu cua day:');
Readln(n);
if n<=0 then Writeln('Ban phai nhap so lon hon 0.');
Until n>0;
For i:=1 to n do
begin
Write('Ban hay nhap so thu ',i,':');Readln(a[i]);
if i>1 then
begin
if (a[i]>0) and (a[i-1]>0) then kq[1]:=kq[1]+1;
if (a[i]*a[i-1]>=0) and (abs(a[i-1])>abs(a[i])) then kq[2]:=kq[2]+1;
if a[i]*a[i-1]<0 then kq[3]:=kq[3]+1;
end;
end;
Writeln('Co ',kq[1],' cap phan tu ke nhau ma ca hai so deu duong.');
Writeln('Co ',kq[2],' cap phan tu ke nhau ma ca hai so cung dau va so dung truoc co gia tri tuyet doi lon
hon so dung sau.');
Writeln('Co ',kq[3],' cap phan tu ke nhau ma ca hai so trai dau nhau.');
Readln;
End.
Bài 17:Tam giác Pascal
Hãy in ra màn hình tam giác Pascal có n dòng và tính xem ở hàng thứ i có bao nhiêu số j (với n, i, j
nhập từ bàn phím).
uses crt;
var
a:array [1 100,1 100] of longint;
i,j,k,m,n,p:longint;
c:char;
Procedure nhap(w:string;var a:longint);
Var k:integer;
s:string;
begin
Repeat
Write(w);Readln(s);
Val(s,a,k);
Until k=0;
end;
Begin
Repeat
clrscr;
Repeat
k:=0;
nhap('Ban hay nhap so n:',n);
if n<=0 then k:=1;
if n>80 then
begin
Write('Ban co chac chan muon nhap so n lon nay khong?(c/k)');
Repeat
c:=Readkey;
Until Upcase(c) in ['C','K'];
if Upcase(c)='K' then k:=1;
Writeln;
end;
Sưu tầm và biên soạn: Nguyễn Minh Đức
23
Bài tập Pascal
Until k=0;
clrscr;
Writeln('n=',n);
For i:=1 to n do a[1,i]:=1;
Gotoxy(40,2);Write('1');
For k:=2 to n do
For i:=1 to k do
begin
if i>1 then a[i,k]:=a[i-1,k-1]+a[i,k-1];
Gotoxy(37-k*6 div 2+i*6,k+1);Write(a[i,k]);
end;
Writeln;
if i>14 then
begin
Textcolor(4);
Writeln('Ban nhap so n hoi lon so voi be rong man hinh cho phep.');
Textcolor(7);
end
else Writeln;
Repeat
Repeat
nhap('Ban hay nhap so i(hang i):',i);
if (i>n) or (i<1) then
Writeln('So i phai nam trong khoang tu 1->n(0<i<',n+1,')');
Until i in [1 n];
nhap('Ban hay nhap so j:',j);
p:=0;
For m:=1 to i do
if a[m,i]=j then p:=p+1;
if p=0 then
Writeln('Hang ',i,' khong co so ',j,' nao.')
else
Writeln('Hang ',i,' co ',p,' so ',j,'.');
Write('Ban co muon nhap tiep hai so i va j khong?(c/k)');
c:=Readkey;
Writeln;
Until Upcase(c)='K';
Write('Ban co muon thuc hien lai ca chuong trinh khong?(c/k)');
c:=Readkey;
Until Upcase(c)='K';
End.
Bài 18. Bài toán số nguyên tố tương đương
Hai số tự nhiên được gọi là nguyên tố tương đương nếu chúng có chung các ước số nguyên tố. Ví
dụ như các số 75 và 15 là nguyên tố tương đương vì cùng có các ước nguyên tố là 3 và 5.
Cho trước hai số tự nhiên M và N. Hãy viết chương trình kiểm tra xem các số này có là nguyên tố
tương đương với nhau không?
uses crt;
var
a:array [1 100] of integer;
i,k,m,n:integer;
Begin
clrscr;
Sưu tầm và biên soạn: Nguyễn Minh Đức
24
Bài tập Pascal
Write('Ban hay nhap so thu nhat:');Readln(m);
Write('Ban hay nhap so thu hai:');Readln(n);
if m<n then begin k:=m;m:=n;n:=k;end;
i:=1;k:=0;
Repeat
i:=i+1;
if (m mod i=0) and (n mod i=0) then
begin
if k=0 then
Writeln('Hai so tren la hai so nguyen to tuong duong voi nhau vi co cac uoc nguyen to:');
k:=1;Write(i,' ');
While (m mod i=0) and (n mod i=0) do
begin
m:=m div i;n:=n div i;
end;
end;
Until i>=n;
if k=0 then
Writeln('Hai so tren khong phai la hai so nguyen to tuong duong voi nhau.');
Readln;
End.
Bài 19. Số siêu nguyên tố
Số siêu nguyên tố là số nguyên tố mà khi bó đi một số tuỳ ý các chữ số bên phải của nó thì phần
còn lại vẫn tạo thành một số nguyên tố. Ví dụ: 7333 là số siêu nguyên tố có 4 chữ số vì 733; 73; 7 đều là
các số nguyên tố.
Hãy lập chương trình nhập dữ liệu vào là một số nguyên N ( 0 < N < 10 ) và đưa ra kết quả là các số siêu
nguyên tố có N chữ số cùng số lượng của chúng.
uses crt;
const
d:array [1 6] of char=('1','2','3','5','7','9');
var
i,k,m,n:integer;
s:string;
c:char;
Function kt(s:string):boolean;
var
k:integer;
a,i:real;
b:boolean;
begin
Val(s,a,k);
b:=True;
i:=1;
While i<=sqrt(a) do
begin
i:=i+1;
if a/i=round(a/i) then
begin
b:=False;
Break;
end;
end;
kt:=b;
end;
Procedure tim(i:integer);
Sưu tầm và biên soạn: Nguyễn Minh Đức
25