Bài tập pascal phần nâng cao

1
PHÉP ĐỆ QUI
Thuật ngữ ĐỆ QUI (recursion ) chỉ tình huống một hàm tự gọi chính nó một cách trực tiếp
hoặc gián tiếp . Phép đệ qui gián tiếp (indirect recursion ) xảy ra khi một hàm a() gọi một
hàm b() , sau đó hàm b() lại gọi hàm a() .Pascal cho phép các hàm đệ qui và trong một số
trường hợp nó tỏ ra là rất có ích
Ví dụ phép đệ quy để tính giai thừa
x!=x*(x-1)!
program bt;
uses crt;
var n:integer;
result:longint;
function gt(n:integer):longint;
begin
if n=0 then gt:=1
else
gt:=n*gt(n-1);
end;
begin
write('Nhap n : ');readln(n);
result:=gt(n);
write(n,' !=',result);
readln;
end.
B1 : lập chương trình tính giá trò của biểu thức
A=SQRT(X+SQRT(X+..SQRT(X))
(n dấu căn ) với x là giá trò được cho từ bàn phím
//chuong trinh de qui de tinh can so
program bt;
var n,number:longint;
x,result:real;

{dinh nghia de qui giai thua}
function f(n:longint) :real;
begin
if(n=1) then
f:=sqrt(x)
else
f:= sqrt(x+f(n-1));
end;
begin
write('Nhap mot so nguyen ');
readln(number);
write('Nhap x : ');readln(x);
result:=f(number);
write('A= ',result:12:2);
readln;
end.


2

ví dụ giá trò nhập vào là x==3 .tức là ta cần tính factoria(3) ,hàm này sẽ được tính như sau :
f
= factoria(3)
a
=a*factoria(3-1)
=a*factoria(2);
factoria(2)
=2*factoria(2-1)
=2*factoria
ví dụ : Dãy Fibonacci : 0,1,1,2,3,5,8,13,21,… bắt đầu bằng 2 số : 0 và 1 và có tính chất là 1 số

Fibonaci bằng tổng của 2 số Fibonacci ngay trước nó .
dãy này xuất hiện tự nhiên và đặc biệt là hình thành dạng xoắn ốc . Tỷ số của các số
Fibonacci liên tiếp hội tụ về một hằng số 1.618 .. số này lại xuất hiện nhiều lần trong tự
nhiên và được gọi là tỷ số vàng (golden ratio hay goden mean )
dãy fibonacci(0)=0
fibonacci(1)=1
fibonacci(n)=fibonacci(n-1)+fibonacci(n-2)
//chuong trinh tinh so Fibonacci thu i
program bt;
uses crt;
var n:integer;
result:longint;
function fibonarci(n:integer):longint;
begin
if (n=1) or (n=2) then fibonarci:=1
else
fibonarci:=fibonarci(n-1)+fibonarci(n-2);
end;
begin
write('Nhap n : ');readln(n);
result:=fibonarci(n);
write('Fibornaci(',n,') =',result);
readln;
end.
Bt1)lập trình đưa dãy số nguyên a1,..an vào máy từ bàn phím .Xếp các số vừa chia hết cho 3
vừa lẻ lên đầu dãy , các số vừa chia hết cho 3 vừa chẵn xuống cuối dãy .đưa ra màn hình dãy
đầu và dãy đã sắp xếp .
Bt1)program vidu;
uses crt;
var a:array[1..100] of integer;

b:array[1..100] of integer;
j,i,n,dem,tam,dem1,dem2:integer;
begin
clrscr;dem:=0;
write('Nhap n : ');readln(n);


3
for i:=1 to n do
begin
write('Nhap a[',i,']= ');readln(a[i]);
end;
for i:=1 to n do
if (a[i] mod 3=0) and (a[i] mod 2<>0) then
begin
inc(dem);
b[dem]:=a[i];
end;
for i:=1 to dem-1 do
for j:=i+1 to dem do
if(b[i]>b[j]) then
begin
tam:=b[i];
b[i]:=b[j];
b[j]:=tam;
end;
for i:=1 to dem do write(b[i]:4);
dem1:=n+1;
for i:=1 to n do
if (a[i] mod 3=0) and (a[i] mod 2=0) then

begin
dem1:=dem1-1;
b[dem1]:=a[i];
end;
for i:=dem1 to n-1 do
for j:=i+1 to n do
if(b[i]>b[j]) then
begin
tam:=b[i];
b[i]:=b[j];
b[j]:=tam;
end;
for i:=dem1 to n do write(b[i]:4);
dem2:=dem;
for i:=1 to n do
if(a[i] mod 3<>0 ) then
begin
inc(dem2);
b[dem2]:=a[i];
end;
for i:=dem+1 to dem2-1 do
for j:=i+1 to dem2 do
if(b[i]>b[j]) then
begin
tam:=b[i];
b[i]:=b[j];
b[j]:=tam;


4

end;
for i:=dem+1 to dem2 do write(b[i]:4);
writeln('Xuat day chua sap xep : ');
for i:=1 to n do write(a[i]:3);
for i:=1 to n do a[i]:=b[i];
writeln('Xuat day sau khi sap xep : ');
for i:=1 to n do write(a[i]:4);
readln;
end.
Bài 2 : lập chương trình nhập một số nguyên N in ra màn hình theo thứ tụ ngược lại của các
chữ số
Ví dụ : 12345 in thành 54321
Bt2)program innguoc;
uses crt;
var a:array[1..10] of longint;
j,i,n:integer;
begin
clrscr;i:=0;
write('Nhap n : ');readln(n);
while (n<>0) do
begin
inc(i);
a[i]:=n mod 10;
n:=n div 10;
end;
writeln('so nguoc cua n la : ');
for j:=1 to i do write(a[j]);
readln;
end.
Bài 3: nhập vào dãy các số nguyên bất kỳ in ra màn hình các số khác nhau của dãy số đó

Bt3)program vidu;
uses crt;
type taptrung=set of byte;
var a:array[1..10] of byte;
trung:taptrung;
j,i,n:integer;
begin
clrscr;i:=0;
write('Nhap n : ');readln(n);
for i:=1 to n do
begin
write('Nhap phan tu a[',i,']= ');readln(a[i]);
end;
trung:=[];
for i:=1 to n do
if not (a[i] in trung) then
begin
write(a[i]:3);
trung:=trung +[a[i]];


5
end;
readln;
end.
Bt4 : Nhap vao một sô 1 xuất ra các thừa số khác nhau của nó
Bt4)program bt;
uses crt;
var n,i,so,J,t,dem:integer;
a:array[1..10] of byte;

begin
clrscr;
write('Nhap so : ');readln(so);
dem:=0;t:=2;i:=0;
while (so<>1 ) do
begin
while (so mod t)=0 do
begin
inc(i);
so :=so div t;
a[i]:=t;
end;
inc(t);
end;
FOR J:=1 TO I DO
BEGIN
WRITE(A[J]);
if (j<>i) then write('x');
end;
readln;
end.
Bài 5 ) 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 .
Bt5)program vidu;
uses crt;
var a:array[1..10,1..10] of integer;
max:array[1..10] of integer;
dau:array[1..10] of boolean;
j,i,n,m,tam:integer;
begin

clrscr;i:=0;
write('Nhap n : ');readln(n);
for i:=1 to n do
for j:=1 to n do
begin
write('Nhap phan tu a[',i,',',j,']= ');readln(a[i,j]);
end;
for i:=1 to n do
begin


6
writeln;
for j:=1 to n do write(a[i,j]:4);
end;
for i:=1 to n do max[i]:=0;
for i:=1 to n do
begin
max[i]:=abs(a[i,1]);
for j:=1 to n do
if max[i]max[i]:=abs(a[i,j])
end;
writeln;
for i:=1 to n do
writeln('lon nhat Hang ',i,' la ',max[i]);
for i:=1 to n do
for j:=1 to n do
begin
if (abs(a[i,j])=max[i]) and (a[i,j]>0) then

begin
max[i]:=max[i];
tam:=a[i,i];
a[i,i]:=max[i];
a[i,j]:=tam;
end;
if (abs(a[i,j])=max[i]) and (a[i,j]<0) then
begin
max[i]:=-max[i];
tam:=a[i,i];
a[i,i]:=max[i];
a[i,j]:=tam;
end;
end;
for i:=1 to n do
writeln('lon nhat Hang ',i,' la ',max[i]);
writeln('Sau sap xep :');
for i:=1 to n do
begin
writeln;
for j:=1 to n do write(a[i,j]:4);
end;
readln;
end.
Hoaëc
program bt;
uses crt;
var a:array[1..20,1..20] of integer;
max:array[1..20] of integer;

7
k,i,j,tam:integer;
begin
clrscr;
write('Nhap k : ');readln(k);
for i:=1 to k do
for j:=1 to k do
begin
write('a[',i,',',j,']=');readln(a[i,j]);
end;
for i:=1 to k do
begin
max[i]:=abs(a[i,1]);
for j:=1 to k do
if max[i]end;
for i:=1 to k do
begin
for j:=1 to k do
if max[i]=abs(a[i,j]) then
begin
tam:=a[i,i];
a[i,i]:=a[i,j];
a[i,j]:=tam;
end;
end;
for i:=1 to k do
begin
writeln;

for j:=1 to k do
write(a[i,j]:4);
end;
readln;
end.
Bai 6: nhập từ bàn phím hai xâu ký tự S1 , s2 .Hãy xét xem S1 có thể nhận được từ S2 bằng
cách gạch đi một số ký tự hay không ?
Bt6)Program Ky_tu;
var
S1,s2:string;
k,i,j:integer;
t:boolean;
begin
Write('Nhap chuoi ky tu 1 : ' );readln(s1);
Write('Nhap chuoi ky tu 2 : ' );readln(s2);
j:=1;
For i:=1 to length(s1) do
Begin
t:=false;


8
While (j<=length(s2))and not(t) do
If (s1[i]=s2[j]) then
t:=true
else Inc(j);
end;
');

if (t) then Write('Co the duoc ' ) else Write('Khong the duoc

readln;
end.
Bt7 : vẽ bàn cờ vua 8 x8 ô lên màn hình
Bt7,program Thanh_Chu_nHat;
uses crt,graph;
var Gd,Gm:integer;
i,k,j:integer;
begin
Gd:=detect;
InitGraph(Gd,Gm,'c:\Tp\Bgi');
for j:=0 to 8 do
for I:=1 to 8 do
begin
k:=(i+j mod 2);
SetFillstyle(1,k);
Bar(I*40+20,20+j*40,i*40+60,60+j*40);
end;
readln;
closegraph;
end.
Bài 8 :
Nhập vào một xâu ký tự bất kỳ . hãy chuẩn hóa xâu đó bằng cách chỉ giữ lại khỏang trống
( dấu cách ) giữa các từ ( từ được hiểu là một dãy ký tự không có khỏang cách )
Bt8)Program chuoi;
var
st:string;
Procedure Xoa(var st:string);
var
i:integer;

Begin
i:=pos(#32#32,st);
While i<>0 do
Begin
delete(st,i,1);
i:=pos(#32#32,st);
end;
end;
Procedure Dem(var st:string);
var
dem,i:integer;
Begin


9
dem:=1;
For i:=1 to length(st) do
If st[i]=' ' then dem:=dem+1;
Writeln('Chuoi co ',dem,' chu ')
end;
Begin

end.

Write('Nhap chuoi : ');readln(st);
Xoa(st);
Writeln(st);
Dem(st);
readln;

Bài 9 : Với giá trò của x nhập từ bàn phím hãy tính tổng
Bt9)Program ddd;
var
s,x:real;
n:longint;
Function bp(x:Real;n:longint):Real;
var
i:longint;
s:real;
begin
s:=1;
For i:=1 to n-1 do
s:=s*x;
bp:=s;
end;
begin
Writeln('Nhap x : ');readln(x);
n:=0;s:=0;
repeat
s:=s+bp((x-1),2*n+1)/((2*n+1)*bp(x+1,2*n+1));
n:=n+1;
until bp((x-1),2*n+1)/((2*n+1)*bp(x+1,2*n+1))<=0.0001;
Writeln('S=',s:5:2,bp(2,5):10:0);
readln;
end.
Bai 10:điền vào các số từ 1 đến n*n theo chiều kim đồng hồ vào mảng 2 chiều . In mãng
kết quả ra màn hình theo dạng n dòng và n cột
Bt 10)program ctyy;
uses crt;

10
var i,j,n:byte;
a:array[1..10,1..10] of byte;
begin
clrscr;
write('Nhap n :');readln(n);
for i:=1 to n do
for j:=1 to n do
begin
a[i,j]:=(j-1)*n+i;
end;
for i:=1 to n do
begin
writeln;
for j:=1 to n do write(a[i,j]:4);
end;
readln;
end.
Bài 11 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 thỏa 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ố lượng các số hạng liên tiếp đan dấu nhiều nhất
bt11)program ctyy;
uses crt;
var i,j,n,k,dem:byte;
min,max,s:longint;

a,b,tong:array[1..20] of longint;
tiep,flag:boolean;
begin
clrscr;
write('Nhap n :');readln(n);
for i:=1 to n do
begin
write('Nhap a[',i,']=');readln(a[i]);
end;
clrscr;
i:=1;tiep:=true;
while (ibegin
if(a[i]<0) then
begin
tiep:=false;
min:=a[i];
end;
i:=i+1;
end;


11
if(i=n) then write('Khong co phan tu am :')
else
begin
for j:=1 to n do
if (a[j]<0) and (a[j]>min) then min:=a[j];
writeln ('Phan tu am lon nhat la :',min);
write('cac phan tu min co chi so :');

for j:=1 to n do
if (a[j]=min ) then write(j:4);
end;
writeln;
i:=1;tiep:=true;
while (ibegin
if(a[i]>0) then
begin
tiep:=false;
max:=a[i];
end;
i:=i+1;
end;
if(i=n) then write('Khong co phan tu duong :')
else
begin
for j:=1 to n do
if (a[j]>0) and (a[j]writeln ('Phan tu duong nho nhat la :',max);
write('cac phan tu max co chi so :');
for j:=1 to n do
if (a[j]=max ) then write(j:4);
end;
writeln;
k:=0;
i:=1;
while (i<=n) do
begin
if(a[i]>0) then

begin
dem:=1;inc(k);j:=i+1;
while (j<=n) and (a[j]>0) do
begin
inc(dem);
j:=j+1;
end;
b[k]:=dem;
i:=i+dem;
end
else
i:=i+1;
end;
min:=b[1];
for i:=1 to k do


12
if b[i]>min then min:=b[i];
writeln('So phan tu duong lien tiep nhieu nhat la :',min);
i:=1;k:=0;
while (i<=n) do
begin
while (a[i]>=0) and(i<=n) do
i:=i+1;
dem:=1;k:=k+1;j:=i+1;tong[k]:=a[i];
while (j<=n) and (a[j]<0) do
begin
tong[k]:=tong[k]+a[j];
inc(dem);

j:=j+1;
end;
b[k]:=dem;
i:=i+dem;
end;
max:=tong[1];
for i:=1 to k do
if max <= tong[i] then max:=tong[i];
writeln('So phan tu am lien tiep co tong lon nhat
la :',max,'so day ',k);
i:=1;k:=0;flag:=false;
while (i<=n) do
begin
dem:=0;
while(a[i]*a[i+1]<0) do
begin
flag:=true;
i:=i+1;
dem:=dem+1;
end;
if flag then
begin
inc(k);
tong[k]:=dem+1;
end;
while(a[i]*a[i+1]>=0) do
i:=i+1;
end;
max:=tong[1];
for i:=1 to k do

if maxwrite('Dan dau :',max);
for i:=1 to n do
write(a[i]:4);
readln;
end.


13
Bt12)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ố hòan hảo có
gia trò từ 1 đến N (nếu có )
( số hòan hảo là một số tự nhiên thỏa mãn điều kiện : Giá trò số đó bằng các ước thực sự
( không kể số đó )
Program bt;
uses crt;
var n,x,i,t,d,s,j,y:integer;
a,b:array [1..10] of integer;
Procedure uoc(var y:integer);
begin
d:=0;
t:=1;
while (tbegin
If y mod t=0 then
begin
inc(d);
a[d]:=t;
end;
inc(t);
end;

end;
Begin
clrscr;
write('Hay nhap n:');readln(n);
x:=1;
j:=0;
while x<=n do
begin
s:=0;
uoc(x);
For i:=1 to d do
s:=s+a[i];
If s=x then
begin
inc(j);
b[j]:=x;
end;
inc(x);
end;
For i:=1 to j do
write(b[i]:5);
readln;
End.
Bài 12b:
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ố hòan hảo có giá trò từ
1 đến n (nếu có )
( số hòan hảo là một số tự nhiên thỏa mãn điều kiện : giá trò số đó bằng tổng các ước thực sự (
không kể số đó ) của nó)
program bt;

14
uses crt;
var i,s,n,k,j,dem,t:integer;
a:array[1..20] of integer;
procedure uoc(var n:integer;var dem:integer);
begin
t:=1;dem:=0;
while tbegin
if n mod t=0 then

end;

begin
dem:=dem+1;
a[dem]:=t;
end;
inc(t);

end;
begin
clrscr;
write('nhap n : ');readln(n);
for j:=2 to n do
begin
s:=0;
uoc(j,dem);
for k:=1 to dem do
s:=s+a[k];

if s=j then
begin
writeln;
write(j,'=');
for i:=1 to dem do
begin
write(a[i]:3);
if i<> dem then write('+');
end;
end;
end;
readln;
end.
Bt 13 Nhập vào 2 mãng 1 chiều a gồm m phần tử , b gồm n phần tử xuất ra mãng c gồm các
phần tử của a, b và đã được sắp xếp
Bt130program bt84_5;
uses crt;
var tam,n,m,i,j:integer;
a,b,c:array[1..100] of integer;
begin
clrscr;


15
write('Nhap n :');readln(n);
write('Nhap m :');readln(m);
for i:=1 to m do
begin
write('Nhap a[',i,']=');readln(a[i]);
end;

for i:=1 to n do
begin
write('Nhap b[',i,']=');readln(b[i]);
end;
for i:=1 to m do
c[i]:=a[i];
for i:=1 to n do
c[i+m]:=b[i];
for i:=1 to n+m-1 do
for j:=i+1 to m+n do
if(c[i]>c[j] ) then
begin
tam:=c[i];
c[i]:=c[j];
c[j]:=tam;
end;
writeln('Day so : ');
for i:=1 to n+m do write(c[i]:4);
readln;
end.
Bt14 : tồng các lập phương
Có bao nhiêu phương pháp viết số tư nhiên N cho trước thành tổng lập phương của 2 số tự
nhiên :
N=i3+j3
Sự hóan vò của các số hạng không được tính, không được sử dụng phép nâng lũy thừa lên
1/3.mở rộng bài tóan nhập vào n xuất ra tất cả các số có thể viết dưới dạng tổng của 2 số lập
phương
Giải bt14
program bt87_3;
uses crt;

var k,n,m,i,j,z:integer;
begin
clrscr;
write('z=');readln(z);
for n:=2 to z do
begin
m:=0;i:=1;j:=1;
while j*j*jrepeat
k:=i*i*i+j*j*j;
if k=n then begin m:=m+1;writeln('so do la :
',n,'=',i,'^3+',j,'^3');end;
if k<=n then inc(i);
if k>=n then dec(j);
until i>j;


16
if m>0 then
writeln('neu la ',n,'co the viet bang ',m,'cach');
end;
readln;
end.
Bt15 cho dãy số xuất ra số phần tử lặp nhiều nhất và số lần xuất hiện của mỗi phần tử
PROGRAM BT85_5;
uses crt;
type
taptrung=set of byte;
var n,i,j,max:integer;
trung:taptrung;

a,b:array[1..100] of integer;
begin
clrscr;
write('Nhap n :');readln(n);
for i:=1 to n do
begin
write('Nhap a[',i,']=');readln(a[i]);
end;
for i:=1 to n do b[i]:=0;
for i:=1 to n do b[a[i]]:=b[a[i]]+1;
max:=0;
for i:=1 to n do if maxtrung:=[];
for i:=1 to n do
if not (a[i] in trung) then
begin
write(a[i]);
trung:=trung+[a[i]];
end;
writeln;
write('spt nhieu nhat ',max);
readln;
end.
Bt16 cho trước một mãng a[1:n] tìm đọan đối xứng dài nhất của mảng a đó ( số đầu tiên bằng
số cuối cùng,số thứ 2 bằng số đứng trước số cuối cùng ), Hãy in ra độ dài của đọan này
program bt;
uses crt;
var i,m,n,p,pn,ln,l,max:integer;
z:boolean;
a:array[1..10] of integer;

begin
clrscr;
write('Nhap n : ');readln(n);
for i:=1 to n do
begin


17
write('Nhap a[',i,']=');readln(a[i]);
end;
pn:=2;ln:=1;z:=true;max:=1;
while pn<=n do
begin
l:=ln;p:=pn;
while (l>=1) and (p<=n) and (a[l]=a[p]) do
begin
dec(l);inc(p);
end;
m:=p-l-1;
if maxif z then pn:=pn+1
else
inc(ln);
z:=not z;
end;
write(max);
readln;
end.
Bt 17:
Cho trước mảng số A[1:m,1:n]

BT18 :Bài tóan xếp hậu : lòet kê tất cả các cách xếp n quân Hậu trên bàn cờ nxn sao cho
chúng không ăn được lẫn nhau
Bt18 program bai_toan_xep_hau;
uses crt;
var n,count:integer;
x:array[1..20] of integer;
a:array[1..20] of boolean;
b:array[2..40] of boolean;
c:array[-19..19] of boolean;
procedure Init;
var i:integer;
begin
write('n=');readln(n);
for i:=1 to n do a[i]:=true;
for i:=2 to 2*n do b[i]:=true;
for i:=1-n to n-1 do c[i]:=true;
count:=0;
end;
procedure result;
var i:integer;
begin
count:=count+1;
if count mod 20=0 then begin


18
write('Nhan mot phim de xem tiep ');readln; end;
write(count:5,'-');
for i:=1 to n do write(x[i]:3);

writeln;
end;
procedure try(i:integer);
var j:integer;
begin
for j:=1 to n do
if a[j] and b[i+j] and c[i-j] then
begin {chap nhan j}
x[i]:=j;
{ghi nhan trang thai moi }
a[j]:=false;b[i+j]:=false;c[i-j]:=false;
if i=n then result else try(i+1);
{tra lai trang thai cu }
a[j]:=true;b[i+j]:=true;c[i-j]:=true;
end;
end;
begin
init;try(1);
write('Go enter de ket thuc ..');readln;
readln;
end.
BT19 : cho môt file văn bản dạng text VAN_BAN.TXT trong đó có chứa một đọan văn bản
Câu a : đọc tệp văn bản đó và in ra màn hình
Câu b : Sửa đọan văn trên theo qui tắc sau :
+ Bỏ đi các dấu cách không cần thiết (nếu có 2 dấu cách liên tiếp thì giữ lại 1 )
+Trước một trong 4 dấu : . , ; : không được có dấu cách
+Sau một trong 4 dấu : . , ; : phải có dấu cách
+đầu một câu phải viết hoa .

BT19

program xfile;
var f1,f2:text;
i,dodai
:integer;
s,st:string;
procedure sua(var st:string);
begin
i:=length(st);
{ xoa cac ky tu ben phai }
while st[i]=#32 do
dec(i);
st[0]:=char(i);


19
i:=1;
{xoa trai }
while st[i]=#32 do
inc(i);
delete(st,1,i-1);
{xoa giua }
i:=pos(#32#32,st);
while i<>0 do
begin
delete(st,i,1);
i:=pos(#32#32,st);
end;
for i:=1 to length(st) do
if ((st[i]='.') or (st[i]=',') or (st[i]=':' ) or (st[i]=';'))
and (st[i-1]=#32) then

delete(st,i-1,1);
for i:=1 to length(st) do
if ((st[i]='.') or (st[i]=',') or (st[i]=':' ) or (st[i]=';'))
and (st[i+1]<>#32) then
insert(#32,st,i+1);
for i:=1 to length(st) do
if st[i]='.' then
st[i+2]:=upcase(st[i+2]);
dodai:=ord(st[0]);
st[0]:=char(dodai);
if st[1]<>#32 then
insert(#32#32,st,1);
end;
begin
write('DOc Ten van ban :');readln(s);
assign(f1,s);
reset(f1);
while not eof(f1) do
begin
readln(f1,st);
writeln(st);
end;
close(f1);
writeln;
reset(f1);
assign(f2,'d:\fnew.txt');
rewrite(f2);
while not eof(f1) do
begin
readln(f1,st);

sua(st);
writeln(f2,st);
end;
close(f1);close(f2);


20
reset(f2);
while not eof(f2) do
begin
readln(f2,st);
writeln(st);
end;
readln;
end.
Bt20 :Đệ qui quay lui và phương pháp nhánh cận
Bài tóan tháp hà nội là một bài tóan cơ bản của thuật tóan đệ qui .Bài tóan phát biểu đơn giản
như sau : Cho 3 cọc A,B,C . Coc A chứa N đóa với quy tắc trên nhỏ dưới to , mỗi lần chuyển
chỉ được chuyển một đóa từ cọc này sang một trong 2 cọc còn lại và giữ nguyên trật tự to nhỏ ,
Hãy đưa ra một cách chuyển N đóa từ A-> C
BT20 program thap_ha_noi;
uses crt;
var N:byte;
T:longint absolute 0:$46C;
T1,T2,DEM:LONGINT;
f:text;
procedure chuyen1(N,C,A,B:byte);forward;
procedure khoi_tao;
begin
write('Vao N:');readln(n);

assign(f,'C:\kq.dat');rewrite(f);
dem:=0;
end;
procedure Chuyen2(N,A,B,C:byte);
begin
if N=1 then begin
writeln(f,chr(A+64),'->',chr(B+64));
writeln(f,chr(A+64),'->',chr(B+64));
dem:=dem+2; end
else begin
chuyen2(N-1,A,C,B);
CHUYEN1(1,A,B,C);
chuyen1(N-1,C,A,B);
chuyen1(1,B,C,A);
chuyen2(N-1,A,C,B); end;
end;
procedure chuyen1(N,C,A,B:byte);
begin
if N=1 then begin
writeln(f,chr(C+64),'->',chr(A+64));
dem:=dem+1; end
else begin
chuyen2(N-1,C,B,A);
CHUYEN1(1,C,A,B);
chuyen2(N-1,B,A,C);


21
end;
end;

procedure thuc_hien;
begin
T1:=T;
chuyen2(N,1,3,2);T2:=T;
write('Thoi gian chay chuong trinh la :',(T2-T1)/18.2:10:10,'giay
');
write(F,'so lan chuyen :',dem);
write('So lan chuyen :',dem);
close(f);readln;
end;
begin
clrscr;
khoi_tao;
Thuc_hien;
readln;
end.
bt4 : Tửụng tửù ta coự theồ vieỏt chửụng trỡnh chuyeồn N ủúa tửứ A sang B nhử sau :
Bt4 program Chuyen_A_B;
uses crt;
var f:text;
name:string;
dem,N:byte;
procedure khoitao;
begin
write('Vao n : ');readln(n);
write('Nhap ten file khoi tao : ');readln(name);
assign(f,name);
rewrite(f);
dem:=0;
end;

procedure Chuyen2(N,A,C,B:byte);forward;
procedure Chuyen1(N,A,B,C:byte);
begin
if N=1 then begin
writeln(F,chr(A+64),'->',chr(B+64));
dem:=dem+1; end
else begin
chuyen2(N-1,A,C,B);
chuyen1(1,A,B,C);
chuyen2(N-1,C,B,A);
end;
end;
procedure Chuyen2(N,A,C,B:byte);
begin
if n=1 then begin
writeln(F,chr(A+64),'->',chr(B+64));
writeln(F,chr(B+64),'->',chr(C+64));


22
dem:=dem+2; end
else begin
Chuyen2(N-1,A,C,B);
chuyen1(1,A,B,C);
chuyen1(N-1,C,A,B);
chuyen1(1,B,C,A);
chuyen2(N-1,A,C,B);
end;
end;
procedure thuchien;

begin
chuyen2(N,1,2,3);
writeln(F,'So lan chuyen : ',dem);
write('so lan chuyen : ',dem);
close(f);readln;
end;
begin
clrscr;
khoitao;
thuchien;
readln;
end.
Bt21 cho xâu ký tự bao gồm các chữ số được lưu trong tệp có tên INPUT.B2 .Ví dụ
Ast25xyz4ghi20mno
Cần sắp xếp lại các số nằm trong xâu ký tự trên .Kết quả được ghi trong tệp có tên
OUTPUT.B2 vò trí các ký tự khác số được giữ nguyên
Trong ví dụ trên kết quả là xâu sau đây
Ast4xyz20ghi25mno
Chú ý khi sắp xếp các số bắt đầu bằng số 0 sẽ tự động bò cắt bớt các chữ số 0 này .Ví dụ nếu
gặp 021 thì chỉ cần sắp lại số 21
Bt21 Program bt;
Type
cs='1'..'9';
var
st1,st2,st3:string;
tam,dem,n,i,s,j,l,k:Integer;
b,a:array[1..50]of Integer;
kthuc:boolean;
ch:set of cs;
Begin

Write('Nhap chuoi 1 :');readln(st1);
n:=LENGTH(st1);
ch:=[];
ch:=ch+['1'..'9'];
Repeat
inc(i);
While (i<=length(st1))and(st1[i]in ch)do
If not(st1[i+1] in ch) then


23
Begin
inc(dem);
st2:=st2+st1[i];
val(st2,s,j);
a[dem]:=s;
b[dem]:=i-length(st2)+1;
st2:='';
inc(i);
end
else
Begin
st2:=st2+st1[i];
inc(i);
end;
Until i>length(st1);
repeat
kthuc:=true;
For i:=1 to dem-1 do
If a[i]>a[i+1] then

Begin
tam:=a[i];
a[i]:=a[i+1];
a[i+1]:=tam;
kthuc:=false;
end;
until (kthuc);
i:=1;
l:=0;
Repeat
val(st1[i],s,j);
If j=0 then
Begin
delete(st1,i,1);
inc(l);
end
else
Begin
Inc(i);
Inc(l);
end;
until l=n;
i:=1;
j:=1;
l:=1;
st3:='';
Writeln(St1);
While i<=n do
Begin
If i=(b[j]) then

begin
str(a[j],st2);
st3:=st3+st2;


24
i:=i+length(st2);
inc(j);
end
else
Begin
st3:=st3+st1[l];
inc(i);
inc(l);
end;
end;
Write(st3);
readln;
end.
Thiết kế xây dựng thư viện của người sử dụng chứa các hàm thủ tục tự tao
Xây dựng Unit tự tạo
Giả sử bạn đã có tệp turbo.exe ,turbo.tpl ,tpc.exe chứa trong thư mục Tp
Sọan thảo một chương trình pascal có tên tệp là Myunit.pas chứa trong thư mục Tp ( như vậy
bạn có 4 tệp tất ca û )
unit myunit;
{thu vien nguoi su dung }
INTERFACE
procedure Bac2(a,b,c:integer);
{khaibao thu tuc tu tao }
IMPLEMENTATION

procedure bac2(a,b,c:integer);
{toan van thu tuc tu tao }
var delta,d,e,m,n,m1,n1,m2,n2:integer;
function U(x,y:integer):integer;
begin
if y=0 then U:=x
else U:=U(y,x mod y);
end;
procedure rutgon(a,b:integer;var c,d:integer);
var n,m:integer;
begin
m:=abs(a);
n:=abs(b);
if a mod b=0 then
begin
if a*b>0 then
begin
c:=m div n;
d:=1;
end
else
begin
c:=-m div n;
d:=1;


25
end;
end
else

begin
if a*b>0 then
begin
c:=m div u(m,n);
d:=n div u(m,n);
end
else
begin
c:=-m div u(m,n);
d:=n div u(m,n);
end;
end;
end;
procedure can(a:integer;var b,c:integer);
var i,h,k,d :integer;
e,dem,m:integer;
begin
e:=a;
h:=round(sqrt(a));
dem:=0;
if h*h=e then
begin
b:=h;
c:=1;
end
else
begin
for i:=2 to h do
begin
k:=i*i;

if e mod k=0 then
begin
d:=e div k;
m:=round(sqrt(k));
inc(dem);
end;
end;
if dem<>0 then
begin
b:=m;
c:=d;
end
else
begin
b:=1;
c:=a;
end;
end;