Bài tập pascal nâng cao (có lời giải)

1. Cho số tự nhiên N và số tự nhiên k. Tính chữ số thứ k trong biểu diễn thập phân của số N.
(Ví dụ cho N=23456 và k=1 thì ta có đáp số là 6, k=4 thì ta có đáp số là 3)
Uses CRT;
Var N: longint;
i, k, d: byte;
Begin
CLRSCR;
Write('Nhập số N:'); Readln(N);
Writeln('Nhập số K<= số chữ số của số N');
Write('K='); Readln(K);
For I:=1 to K do
Begin
d:=N mod 10;
N:=N div 10;
End;
Write('Số thứ', K, 'Trong biểu diễn thập phân của số', N, 'là', d);
Readln;
End.
2. Xét bảng số:

4

5

6

7

0

3

2

1

0

7

2

3

0

1

6

1

0

3

2

5

0

1

2

3

4

Các phần tử của bảng được điền theo qui luật sau:
- Phần tử góc trái dưới được điền số đầu tiên: 0
1


- Các số tiếp theo của bảng sẽ được điền theo thứ tự từ dưới lên và từ trái qua phải theo
nguyên tắc: số được điền sẽ là số nguyên không âm nhỏ nhất chưa được điền của các hàng và
cột chứa ô hiện tại.
a. Chứng minh rằng các ô trên đường chéo chính (45 độ) sẽ chứa toàn số không.
b. Bảng số trên sẽ đối xứng qua đường chéo trên.
c. Viết chương trình điền các số của bảng trên trong mảng 2 chiều NxN với N nhập từ bàn
phím.
3. a. Ta chứng minh a[n,n]=0 (1) bằng qui nạp tiến theo n.
Với n=1 ta có a[1,1]=0 vì là phần tử góc trái dưới.
Giả sử (1) đúng đến n, ta phải chứng minh (1) đúng với n+1, nghĩa là a[n+1,n+1]=0.
Thực vậy, khi điền phần tử a[n+1, n+1] ta để ý rằng các phần tử đã điền ở cột thứ n+1, tức là
các phần tử dạng a[k, n+1], k=1, 2, ..., n không thể là số 0 được vì trên các hàng thứ k (k=1, 2,
...n) đã có a[k,k]=0; tương tự như vậy: các phần tử đã điền ở hàng thứ n+1 dạng a[n+1,k],
(k=1, 2,... n), cũng không thể bằng 0 vì trên các cột thứ k (k=1, 2,... n) đã có các phần tử
đường chéo a[k, k]=0. Như vậy số 0 chính là số nguyên không âm nhỏ nhất chưa được điền
trên hàng thứ n+1, và cột thứ n+1. Do đó a[n+1, n+1]=0.

Vậy (1) đúng với mọi n = 1, 2, ...
b. Để chứng minh a[i, j] = a[j, i] (2) ta để ý rằng trường hợp i=j thì a[i, i] = a[i, i] là hiển
nhiên, như vậy ta chỉ cần chứng minh (2) cho i ạ j. Không mất tính tổng quát ta giả sử i>j, tức
là phần tử a[j, i] được điền trước phần tử a[i, j].
Ta chứng minh a[i, j] =a[j, i] (2), i>j bằng qui nạp tiến theo thứ tự điền các phần tử.
Với j=1, i=2 rõ ràng a[2, 1] = a[1, 2].
Giả sử (2) đúng đến a[i,j] và i>j+1, ta phải chứng minh (2) đúng với a[i,j+1], nghĩa là a[i,j+1]
=a[j+1,i].
Ta để ý rằng khi điền phần tử a[j+1, i] ta phải xét tập hợp A tất cả các số nguyên dạng a[k, i],
k=1,..,j và a[j+1, l], l=1..i-1 là các phần tử đã điền trước a[j+1, i] nằm trên hàng thứ j+1 và cột
thứ K; sau đó chọn a[j+1, i] là số nguyên không âm nhỏ nhất không trùng với số nào trong tập
A.
Khi điền phần tử a[i, j+1] ta phải xét tập hợp B các số nguyên đã điền trên hàng thứ i và cột
thứ j+1, đó là các số dạng a[i, k], k=1..j và a[l, j+1], l=1..i-1. Nhưng theo giả thiết qui nạp ta
có a[k, i]=a[i, k], " k=1..j và a[j+1, l] =a[l, j+1], " l=1..i-1. Do đó tập A trùng với tập B và vì
vậy a[i, j+1] cũng chính là số nguyên không âm nhỏ nhất không trùng với số nào trong tập A.
vậy a[i, j+1] =a[j+1, i].
Vậy (2) đúng với mọi i>j.
c. Program P2323c;
Var
a: array[1..100, 1..100] of byte;
2


n, i, j, k, l, b: byte; d: boolean;
Begin
Write('Nhập kích thước của mảng hai chiều NxN, N='); Readln(n);
For i:=1 to n do
For j:=1 to n do
Begin

b=0 {Bắt đầu kiểm tra từ số nguyên nhỏ nhất}
Repeat
d:=False;
If j>1 then For k:=1 to j-1 do {hàng i}
If a[i, k]=b then d:=TRUE; {đã dùng}
If i>1 then For k:=1 to i-1 do {cột j}
If a[K, j] = b then d:=TRUE; {đã dùng}
b:=b+1; {Kiểm tra số tiếp theo}
Until not d
a[i, j] =b-1;
End;
End.
4. 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. 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.
5. a. Program P2326a;
Var
a: array [1..100] of integer;
n, i: byte;
Begin
Write('Nhập số phần tử của dãy đối xứng:'); Readln(n);
Writeln('Nhập các phần tử của dãy:');
For i:=1 to (n+1) div 2 do
3


Begin
Write('a[', i:2, ']='); Readln(a[i]);
a[n-i+1] := a[i];
End;
End.

b. Program P2326b;
Var
a: array [1..100, 1..100] of integer;
n, i, j
Begin
Write('Nhập kích thước của mảng đối xứng:'); Readln(n);
Write('Nhập các phần tử của mảng:');
For i:=1 to n do
For j:=1 to i do
Begin
Write('a[', i:2, ',', j:2, ']='); Readln(a[i, j]);
a[i, j]:=a[j, i];
End;
Readln;
End.
6. Cho trước dãy số. Hãy tìm một dãy con liền nhau cực đại có các phần tử bằng nhau.
Program P2510;
USES crt;
VAR
a:array [1..100] of integer;
n,i,j,k,kmax,id:byte;
BEGIN
Clrscr;
4


Write(' Nhap do dai cua day : ');Readln(n);
For i:=1 to n do
Begin
Write(' a[',i,'] = ');Readln(a[i]);

End;
kmax:=0;
For i:=1 to n do
Begin
j:=i;
while a[i]=a[j] do inc(j);
k:=j-i;
If k>kmax then
Begin
kmax:=k;
id:=i;
End;
End;
Writeln('Day con lien nhau cuc dai cac phan tu bang nhau cua day : ');
For i:=id to id+kmax-1 do Write(a[i]:4);
Readln;
END.
7. Cho trước số tự nhiên N. Viết chương trình in ra tất cả các ước số khác nhau của N.
(Gợi ý: sử dụng chương trình của bài trên)
. Program P2804;
Var
n, i: integer;
Begin
Write(' Nhập N:'); Readln(n);
5


n:= abs(n);
Writeln (' ước số của N là: ');
If n = 1 then Writeln(n);

If n>1 then
For i:=2 to n do
If n mod i = 0 then Writeln(i);
Readln;
End.
8. Cho dãy số được nhập từ bàn phím. Hãy chỉ ra một dãy con liên tục đơn điệu tăng có độ dài
lớn nhất. Chương trình phải in ra được dãy con đó.
Uses crt;
Var A:array[1..100] of integer;
d,c,i,j,N:byte;
BEGIN
Clrscr;
Write('So phan tu cua day la N=');readln(N);
For i:=1 to N do
Begin
Write('a[',i,']='); readln(a[i]);
End;
d:=0;
c:=0;
i:=1;
Repeat
If A[i]>A[i+1] then inc(i)
Else
Begin
j:=i;
While (i<=N)and(A[i]<=A[i+1]) do inc(i);
6


If (i-j)>(c-d) then

Begin
d:=j;
c:=i;
End;
End;
Until i>N;
If d<>0 then
Begin
Writeln('Day con lien tuc don dieu tang co do dai lon nhat la');
For i:=d to c do write(A[i]:5);
End
Else Writeln('Khong ton tai day con don dieu tang co >1 phan tu');
Readln;
END.
9. Cho xâu ký tự S. Viết chương trình tính xem trong S có bao nhiêu chữ cái tiếng Anh
(không phân biệt chữ in hoa hay thường). Ví dụ với S là "Ha thanh" ta có đáp số là 4.
Var S: string;
i, j, dem: integer;
Begin
write('Cho một xâu ký tự S: '); Readln(S);
i:=2; dem:=1
While (i<= length(S) do
begin
j:=1
While (Upcase (S[j]) <> Upcase(S[i])) and (j<=(i-1)) do inc(j);
if j=i then dem:= dem+1;
inc(i);
end;
7

write('Số chữ cái tiếng Anh trong xâu là: ', dem:4);
Readln;
End.
6. Viết chương trình nhập một dãy 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;
8

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 jm:=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.
10. Cho trước một xâu ký tự bất kỳ. Trong xâu trên sẽ có xen kẽ các ký tự số và ký tự không
là số. Ví dụ:

dgghhg456cghh086chgh1fdfgdfg76cgf
9


Viết chương trình tách các phần là "số" của xâu trên và đưa ra một mảng số nguyên. Trong ví
dụ trên mảng số sẽ có 4 phần tử bao gồm 456, 86, 1 và 76.
USES crt;
CONST
so: set of char = ['0','1','2','3','4','5','6','7','8','9'];
VAR
a: array[1..100] of integer;
st,b: string;
l,i,n: byte;
c: integer;
BEGIN
clrscr;
writeln('Chuong trinh xu li xau co so :');
write('Nhap mot xau co so : ');readln(st);
l:=length(st);
i:=1; n:=0;
repeat
if (st[i] in so) then
begin
b:= '';
repeat
b:=b+st[i];
inc(i);
until (not(st[i] in so))or(i>l);
inc(n);
val(b,a[n],c);

end;
inc(i);
until i>l;
10


for i:=1 to n do write(a[i]:8);
readln;
END.
11. Cho hai dãy số
a1, a2, a3, ..., an
b1, b2, b3, ..., bn
Hãy viết chương trình tìm ra một dãy con chung liên tục có độ dài lớn nhất của hai dãy trên.
uses crt;
var
a,b:array[1..100] of integer;
n,i,j,jmax,k,kmax:byte;
ch:char;
BEGIN
clrscr;
writeln('Chuong trinh tim mot day con chung lien tuc cua hai day so: ');
write('Nhap do dai N cua hai day : ');readln(N);
writeln('Nhap day a : ');
for i:=1 to n do
begin
write('a[',i,'] = ');readln(a[i]);
end;
writeln('Nhap day b : ');
for i:=1 to n do
begin

write('b[',i,'] = '); readln(b[i]);
end;
kmax:=0;
for i:=1 to n do
11


for j:=1 to n do
begin
if a[i]=b[j] then
begin
k:=0;
repeat
inc(k);
until (i+k>n)or(j+k>n)or(a[i+k]<>b[j+k]);
if kmaxbegin
kmax:=k;
jmax:=j;
end;
end;
end;
if kmax=0 then writeln('Hai day a va b khong co day con nao !')
else
begin
writeln('Hai day a va b co day con chung lien tuc dai nhat la :');
for j:=jmax to jmax+kmax-1 do write(b[j]:8);
end;
readln;
END.

12


12. Viết chương trình nhập số tự nhiên N và in ra dòng thứ N của tam giác Pascal.
Uses crt;
Var
a:array[0..33] of longint;
i,j,n:0..33; { n>33 thi he so > maxlongint }
Begin
Clrscr;
Writeln('Tam giác Pascal:');
Write('Nhấp số n:'); Readln(n);
For i:=0 to n 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];
End;
For j:=0 to n do Write(a[j]:10);
Readln;
End.
13. Xét bàn cờ vua 8x8. Các ô được đánh dấu bởi vị trí hàng và cột, ví dụ vị trí (1,2) chỉ ra vị
trí hàng 1 cột 2.
Cho trước k vị trí, trên đó đã xếp k quân hậu: (i1,j1), (i2,j2), ..., (ik,jk).
Viết chương trình kiểm tra xem k quân hậu trên có ở trong trạng thái độc lập hay không (tức
là không quân nào có thể khống chế quân nào).
Trường hợp các quân trên đã độc lập hãy kiểm tra xem có thể bổ xung thêm một quân hậu
nữa mà vẫn bảo đảm tính độc lập được hay không, nếu được hãy chỉ ra vị trí của quân hậu
mới.

Uses crt;
Var
ih, jh: array[1..8] of byte;
13


i, j, k: byte;
ihm, jhm: integer;
dl, ok, t: boolean;
Begin
Clrscr;
Writeln('Nhập vị trí của k quân hậu trên bàn cờ (1<=k,ik,jk<=8):');
Write(' k = ');Readln(k);
For i:=1 to k do
Begin Write('(i',i,',','j',i,')=');Readln(ih[i],jh[i]); End;
dl:=true;
For i:=1 to k do
For j:=1 to k do
If (i<>j)and((ih[i]=ih[j])or(jh[i]=jh[j]) or(abs(ih[i]-ih[j])=abs(jh[i]-jh[j]))) then dl:=false;
If not(dl) then Writeln('Các con hậu trên không ở trong trạng thái độc lập.')
Else
Begin
Writeln(' Các con hậu trên ở trong trạng thái độc lập.');
ok:=false;
ihm:=1;
Repeat
jhm:=1;
Repeat
t:=false;
For i:=1 to k do If (ihm=ih[i])and(jhm=jh[i]) then t:=true;

If not(T) then
Begin
ok:=true;
For i:=1 to k do
14


If((ih[i]=ihm)or(jh[i]=jhm)or(abs(ih[i]-ihm)=abs(jh[i]-jhm)))
then ok:=false;
End;
inc(jhm);
Until (jhm>8)or(ok);
inc(ihm);
Until (ihm>8)or(ok);
If ok then Writeln(' Có thể bổ sung thêm một quân hậu nữa vào vị trí',ihm-1:3,jhm-1:3)
Else Writeln(' Không thể bổ sung thêm một quân hậu nào nữa.');
End;
Readln;
End.
14. Một file văn bản ghi số liệu của học sinh có dạng sau:
4
Nguyen Van Hung 15 G
Bui Quang Than 14 K
Tran Minh Quang 16 G
Le Van Minh 15 T
Dữ liệu ghi trong file này có ý nghĩa như sau:
- Dòng đầu tiên ghi đúng một số n chỉ số lượng học sinh trong lớp.
- n dòng tiếp theo mỗi dòng ghi dữ liệu của một học sinh.
- Mỗi học sinh được ghi các dữ liệu sau:
Họ và tên: 20 ký tự

Tuổi: 3 ký tự
Xếp loại: 1 ký tự
15.Hãy viết chương trình nhập dữ liệu học sinh từ file trên và đưa vào các mảng dữ liệu tương
ứng, tên file cũng được đọc từ bàn phím.
Program P4609;
Uses crt;
15


Var
f: text;
fn: string; {Tên file}
n, i: integer;
ht: array[1..100] of string[20];
t: array[1..100] of string[3];
xl: array[1..100] of char;
Begin
Clrscr;
Write('Tên file cần đọc: '); Readln(fn);
assign(f,fn);
reset(f);
Readln(f,n);
For i:=1 to n do
Readln(f, ht[i], t[i], xl[i]);
close(f); {kiểm tra}
For i:=1 to n do
Writeln(ht[i],t[i]:4,xl[i]:3);
Readln;
End.
17. Cho trước một xâu nhị phân độ dài bất kỳ được đưa vào từ file văn bản INPUT.TXT. Cần

biến đổi xâu nhị phân này về dạng toàn số 0. Các phép biến đổi có thể chỉ là một trong các
loại sau:
- Biến đổi xâu con 11 thành 00.
- Biến đổi xâu con 010 thành 000.
Hãy chỉ một cách biển đổi xâu đã cho thành xâu có toàn 0. Kết quả thể hiện trong file
OUTPUT.TXT như sau:
Dòng đầu tiên của OUTPUT.TXT chứa xâu ban đầu, sau đó mỗi dòng là một xâu tiếp theo
sau một phép biến đổi, xâu cuối cùng là xâu toàn 0.
Uses crt;
16


Const
st1='11';
st2='010';
Var
fin, fou: text;
l, p: integer;
st: string;
(*==========================================*)
Procedure ghi1(i:integer);
Begin
st[i]:='0';
st[i+1]:='0';
Writeln(fou, st);
End;
(*==========================================*)
Procedure ghi2(i:integer);
Begin
st[i+1]:='0';

Writeln(fou, st);
End;
(*==========================================*)
Begin
Clrscr;
assign(fin, 'input.txt');
reset(fin);
Readln(fin, st);
close(fin);
l:=length(st);
17


If ((st[l]='1')and(st[l-1]='0'))or((st[1]='1')and(st[2]='0')) then
Writeln('Không thể biến đổi được!')
Else
Begin
assign(fou,'output.txt');
rewrite(fou);
Writeln(fou,st);
If (st[l]='1')and(st[l-1]='1') then ghi1(l-1);
Repeat { biến đổi xâu con '11' }
p:=pos(st1,st);
If (p<>0) then ghi1(p);
Until (p=0);
Repeat {biến đổi xâu con '010' }
p:=pos(st2,st);
If (p<>0) then ghi2(p);
Until (p=0);
close(fou);

{kiểm tra}
assign(fou,'output.txt');
reset(fou);
While not(seekeof(fou)) do
Begin
Readln(fou,st);
Writeln(st);
End;
close(fou);
End;
Readln;
18


End.
20. Tại một sân ga người ta xét hành lý của hành khách và ghi kết quả vào file có tên
KHACH.INF sao cho mỗi hành khách được ghi trên một dòng, mỗi kiện hàng được ghi rõ số
cân trên hàng đó. Ví dụ một file như vậy có dạng sau:
4
12 4 5.5 6 2
21
15 5
16
File trên có ý nghĩa sau: có tất cả 4 hành khách, hành khách 1 có 5 kiện hàng với số cân tương
ứng là 12, 4, 5.5, 6 và 2kg, khách thứ hai có 1 kiện nặng 21 kg....
Hãy viết chương trình thực hiện các công việc sau:
Tính tổng số cân của mỗi hành khách và in kết quả ra file có tên CAN.KQ, mỗi hành khách là
một số trên một hàng. Ví dụ với file đầu vào như trên thì kết quả sẽ là:
29.5
21

20
7
Kiểm tra và in ra những khách hàng không đủ tiêu chuẩn đi tàu. Số liệu được ghi ra file có tên
HUY.KQ, mỗi dòng ghi số thư tự hành khách không đủ điều kiện. Biết rằng hành khách sẽ
không đủ điều kiện đi tầu nếu tổng số trọng lượng hàng hóa lớn hơn 20 kg hoặc có quá 10
kiện hàng. Trong ví dụ trên các hành khách số 1 và 2 là không đủ điều kiện do đó file kết quả
sẽ có dạng:
1
2
Uses crt;
Var
fin, fou, fhuy: text;
sum, can: real;
n, i, k: byte;
Begin
Clrscr;
19


assign(fin, 'KHACH.INF');
reset(fin);
Readln(fin, n);
assign(fou, 'CAN.KQ');
reWrite(fou);
assign(fhuy, 'HUY.KQ');
rewrite(fhuy);
For i:=1 to n do
Begin
sum:=0;
k:=0;

While not(seekeoln(fin)) do
Begin
Read(fin,can);
sum:=sum+can;
k:=k+1;
End;
Writeln(fou, sum);
If (sum>20)or(k>10) then Writeln(fhuy, i);
Readln(fin);
End;
close(fin);
close(fou);
close(fhuy);
assign(fou, 'CAN.KQ');
reset(fou);
Writeln(' File ''CAN.KQ'' :');
While not(seekeof(fou)) do
20


Begin
Readln(fou, sum);
Writeln(sum:6:2);
End;
close(fou);
assign(fhuy, 'HUY.KQ');
reset(fhuy);
Writeln('File ''HUY.KQ'' :');
While not(seekeof(fhuy)) do
Begin Readln(fhuy,i); Writeln(i); End;

close(fhuy);
Readln;
End.
1. Viết chương trình nhập số tự nhiên N và in ra chữ số thứ N của dãy vô hạn các số nguyên
không âm chẵn: 0246810121416182022....
Uses crt;
var N: longint;
(*==========================================*)
Function chuso(NN: longint): char;
Var st:string[12];
dem,M:longint;
Begin
dem:=0;
M:=0;
Repeat
M:=M+2;
Str(M,st);
dem:=dem+length(st);
Until dem>=NN;
21


chuso:=st[length(st)-(dem-NN)];
End;
(*==========================================*)
Begin
Clrscr;
Write('Nhập N(<=2147483647):'); Readln(N);
Writeln('Chữ số thứ ',N,' dãy vô hạn các số nguyên không âm');
Write('chẵn 0246810121416182022...là :',chuso(N));

Readln;
End.
. Viết chương trình nhập số tự nhiên N và in ra chữ số thứ N của dãy vô hạn các số tự nhiên
lẻ: 1357911131517192123....
Uses crt;
Var N: longint;
(*==========================================*)
Function chuso(NN: longint): char;
{Trả về chữ số thứ NN của dãy vô hạn các số nguyên không âm lẻ
135791113151719212325.....}
Var st: string[10];
dem, M: longint;
Begin
dem:=0;
M:=-1;
Repeat
M:=M+2;
Str(M,st);
dem:=dem+length(st);
Until dem>=NN;
chuso:=st[length(st)-(dem-NN)];
22


End;
(*==========================================*)
Begin
Clrscr;
Write('Nhập N(<=2147483647):'); Readln(N);
Writeln('Chữ số thứ ',N, 'dãy vô hạn các số nguyên không âm');

Write('lẻ 135791113151719212325...là:', chuso(N));
Readln;
End.
3. Viết chương trình nhập số tự nhiên N và in ra chữ số thứ N của dãy vô hạn các số chính
phương: 1491625....
Uses crt;
Var N: longint;
(*==========================================*)
Function chuso(NN: longint): char;
{Trả về chữ số thứ N của dãy vô hạn các số chính phương 1491625364981100121144... }
Var Bp, M, dem: longint;
s: string[10];
Begin
M:=0;
dem:=0;
Repeat
inc(M);
Bp:=M*M;
str(Bp,s);
inc(dem,length(s));
Until dem>=NN;
chuso:=s[length(s)-(dem-NN)];
End;
23


(*==========================================*)
Begin
Clrscr;
Write('Nhập N='); Readln(N);

Writeln('Chữ số thứ', N, 'của dãy vô hạn các số chính phương');
Write('1491625364981100121144...là :', chuso(N));
Readln;
End.
11. Viết chương trình thực hiện trò chơi sau:
Có N số 1, 2, 3, ..., N được lần lượt xếp trên vòng tròn theo chiều kim đồng hồ. Các số tự
nhiên N, k được đọc vào từ bàn phím ngay từ đầu trò chơi. Để mỗi lần thực hiện trò chơi trên
máy sẽ làm các việc sau:
Yêu cầu người chơi nhập một số tự nhiên A (1 <= A <= N). Đây chính là số mà người chơi
muốn máy xóa đi chậm nhất.
Bắt đầu từ số 1 máy bắt đầu đi dạo theo chiều kim đồng hồ, cứ đến số thứ k máy sẽ xóa số đó
đi khỏi vòng tròn và thông báo ngay với người chơi.
Chương trình dừng khi máy xóa đến số A, máy sẽ thông báo số điểm mà bạn đạt được: xóa
mỗi số trước số A sẽ được một điểm. Như vậy bạn chơi càng giỏi thì điểm càng cao.
Uses crt;
Const MaxN=1000;
Type Khoang=1..MaxN;
Var A, N, k: Khoang;
next: char;
SO: array[Khoang] of integer;
(*==========================================*)
Procedure input(Var Ai, Ni, ki: khoang);
Begin
Writeln('Nhậ A, k và N (1 ú A úN )');
Repeat
Write('Số chữ số N=');Readln(Ni);
If Ni<1 then Write('Nhập lại.');
24

Until Ni>=1;
Repeat
Write('Chữ số thứ K cần xoá k='); Readln(ki);
If ki<1 then Write('Nhập lại.');
Until ki>=1;
Repeat
1 Write('Số bạn muốn máy xoá đi chậm nhất là');
1Write(' A='); Readln(Ai);
1If (Ai>Ni)or(Ai<1) then Write('Nhập lại.');
Until (1<=Ai)and(Ai<=Ni);
End;
(*==========================================*)*Procedure
print(buoc, )
soxo a:integer Var j: integer;
Begin
textcolor(WHITE);
Writeln(buoc, '.Xoá số ', soxoa);
For j:=1 to N do
1 Begin
11 If SO[j]=0 then Textcolor(RED)
11 else1Textcolor(WHITE);
11 If SO[j]<>0 then Write(SO[j]:5)
11 else Write('X':5);
1End;
Writeln;
delay(400);
End;
(*==========================================*)
Procedure play(A1, N1, k1: integer);
25