Một số bài toán ứng dụng

Một phần của tài liệu Ngôn ngữ lập trình Pascal ĐH Hoa Lư (Trang 131)

5.1. Sắp xếp

Để tiện trình bày, ta coi n ≤ 100, giá trị các phần tử A[i] của mảng A có kiểu Integer. Ta định nghĩa các hằng số Max và kiểu Vec (Vector) như sau:

const Max=100;

type Vec=array[1..Max] of Integer;

Ta định nghĩa một thủ tục hoán đổi giá trị:

procedure Swap(var x, y: Integer); begin

x:=x+y; y:=x-y; x:=x-y end;

Các thủ tục sau đều sử dụng kiểu Vec. Hơn nữa, tham số hình thức Increment được đưa vào nhằm chỉ định chiều của sự sắp xếp. Increment bằng True (hoặc False) tương ứng với sắp xếp theo chiều tăng (hoặc giảm).

a. Sắp xếp chọn

procedure SelectSort(var A: Vec; n: Byte; Increment: Boolean); var i, j, k: byte; begin for i:=1 to n-1 do begin j:=i; for k:=i+1 to n do

if (A[k]<A[j])= Increment then j:=k; if j>i then Swap(A[i], A[j])

end;

b. Sắp xếp chèn(Insertion sort)

procedure InsertSort(var A: Vec; n: Byte; Increment: Boolean); var i, j: byte; Temp: Integer;

begin

for i:=2 to n do

if (A[i]<A[i-1])= Increment then begin

j:=i;

Temp:=A[i];

while (j>1) and ((Temp <A[j-1])=Increment) do begin A[j]:=A[j-1]; j:=j-1 end; A[j]:=Temp end end;

c. Sắp xếp nổi bọt (Bubble sort)

procedure BubbleSort(var A: Vec; n: Byte; Increment: Boolean); var i, j: byte;

begin

for i:=1 to n-1 do

for j:=n downto i+1 do

if (A[j]<A[j-1])= Increment then Swap(A[j-1], A[j])

Nhận xét: Trong thuật toán sắp xếp nổi bọt, rất có thể ứng với giá trị i nào đó nhỏ hơn n-1, một lượt duyệt lùi của j từ n đến i+1 các phần tử không đổi chỗ lần nào. Điều đó chứng tỏ mảng đã đúng thứ tự, nên không cần xét với các bước i lớn hơn nữa. Vì vậy, ta có thể cải tiến thuật toán trên như sau:

procedure BubbleSort(var A: Vec; n: Byte; Increment: Boolean); var i, j: byte; Temp: Integer; OK: boolean;

begin

OK:=False; i:=1;

while (i<n) and (not OK) do begin

OK:=True;

for j:=n downto i+1 do

if (A[j]<A[j-1])= Increment then

begin Swap(A[j-1], A[j]); OK:= False end; i:=i+1 end end;

d. Sắp xếp kiểu hoà nhập (Merge sort).

* Đặt vấn đề: Hoà nhập là phép hợp nhất hai mảng (cùng kiểu giá trị) đã được sắp xếp cùng chiều thành một mảng thứ ba cũng được sắp xếp theo chiều đó. Giả sử có hai mảng A và B với số phần tử tương ứng là m và n, ta hợp nhất thành mảng V.

*Thuật toán: Giả sử hai mảng A và B đã được sắp xếp không giảm. Xét từ đầu hai mảng A và B, nếu giá trị của phần tử đang xét của mảng A nhỏ hơn giá trị đang xét của mảng B thì phần tử mới của mảng C sẽ là phần tử đang xét của mảng A, ngược lại lấy phần tử đang xét của mảng B. Khi một trong hai mảng đã được xét hết, thì các phần tử còn lại của mảng kia sẽ lần lượt được nạp hết vào cuối mảng C.

Ta định nghĩa mảng C với số phần tử bằng tổng số phần tử của cả A và B.

type Vec2=array[1..2*Max] of integer;

var i, j, k: byte; begin

i:=1; j:=1; k:=0;

while (i<m) and (j<n) do if A[i]<B[j] then

begin k:=k+1; C[k]:=A[i]; i:=i+1 end

else begin k:=k+1; C[k]:=B[j]; j:=j+1 end; if i>m then

while j<=n do

begin k:=k+1; C[k]:=B[j]; j:=j+1 end else while i<=m do

begin k:=k+1; C[k]:=A[i]; i:=i+1 end end;

Độ phức tạp của thuật toán là O(m+n).

5.2 Tìm kiếm

a. Tìm kiếm tuần tự (sequential searching)

function SequenSearch(A: Vec; n:byte; X: integer):byte; var k:byte;

begin

k:= 1;

while (k<=n) and (A[k]<>X) do k:=k+1; if k > n then SequenSearch:=0

end;

b. Tìm kiếm nhị phân (Binary searching)

function Search(A: vec; left, right: byte; x: integer):byte; var midle: byte;

begin

if left > right then

else begin

midle:=(left+right) div 2; if A[midle]= x then

begin Search:=midle; exit end else

if x < A[midle] then Search:= Search(A, left, midle-1, x) else Search:= Search(A, midle+1, right, x)

end end;

function BinarySearch(A: vec; n: byte; x: integer):byte; begin

BinarySearch:= Search(A, 1, n, x) end;

5.3 Biến đổi ma trận

Const nMax=10;

type Vec=array[1..nMax] of real;

Mat=array[1..nMax,1..nMax+1] of real;

a. Nhập mảng một chiều

procedure VecInput(var A: Vec; n: byte; Name: Char); var k: byte; begin for k:=1 to n do begin write(Name, '[', k, ']= '); readln(A[k]) end end; b. Tính tích vô hướng

var k: byte; Result: real; begin

Result:=0;

for k:=1 to n do Result:= Result + A[k]*B[k]; ScalarProduct:=Result

end;

c. Nhập mảng hai chiều

procedure MatInput(var A: Mat; m, n: byte; Name: Char); var i,j: byte;

begin

writeln('Nhap Ma tran ', Name, ':'); for i:=1 to m do for j:=1 to n do begin write(Name, '[',i, ',', j,']= '); readln(A[i, j]) end end;

d. Hiển thị mảng hai chiều

procedure MatDisplay(A: Mat; m, n: byte; Name: Char); var i,j: byte;

begin

writeln('Ma tran ', Name, ' la:'); for i:=1 to m do begin for j:=1 to n do write(A[i, j]:10:4); writeln end end;

e. Hiển thị ma trận tam giác trên

procedure MatAboveDisplay(A: Mat; n: byte); var i,j: byte;

begin for i:=1 to n do begin for j:=1 to n do if i <= j then write(A[i, j]:8:1) else write(#32:8); writeln end end; f. Tính tổng hai ma trận.

procedure MatSum(A, B: Mat; var C: Mat; m, n: byte); var i, j, k: byte;

begin

for i:=1 to m do for j:=1 to n do

C[i, j]:= A[i, j] + B[i, j] end;

g. Tính tích hai ma trận.

procedure MatProduct(A, B: Mat; var C: Mat; m, p, n: byte); var i, j, k: byte; begin for i:=1 to m do for j:=1 to n do begin C[i, j]:= 0; for k:= 1 to p do

C[i, j]:= C[i, j] + A[i, k]*B[k, j] end

end;

h.Tìm phần tử lớn nhất trên cột Col, kể từ hàng Col đến hàng n của ma trận A.

function MaxRow(A: Mat; Col,n: byte): byte; var i, k: byte;

begin k:=Col;

for i:= Col + 1 to n do

if abs(A[i, Col]) > abs(A[k, Col]) then k:=i; MaxRow:= k

end;

i. Hoán đổi x với y.

procedure Swap(var x, y: real); var t: real;

begin

t:=x; x:=y; y:=t end;

j. Hoán đổi hàng p với hàng r, kể từ cột thứ p của ma trận A

procedure RowSwap(var A: Mat; p, r, n: byte); var j: byte;

begin

for j:=p to n do Swap(A[p,j], A[r,j]) end;

k. Đưa ma trận A về dạng tam giác trên trên theo phương pháp Gausse.

function AboveConvert(var A: Mat; n: byte; var Sign: shortint): boolean; var i,j, k, p: byte; t: real; Stop: boolean;

k:=0; Sign:=1; Stop:= False; repeat

k:=k+1;

p:= MaxRow(A, k, n);

if p > k then begin RowSwap(A, k, p, n+1); Sign:=-Sign end; if A[k,k] <> 0 then

for i:=k+1 to n do begin

t:=A[i, k]/A[k, k];

for j:=k to n+1 do A[i, j]:= A[i,j] - t*A[k,j] end

else Stop:=True until (k=n-1) or Stop; AboveConvert:= not Stop end;

l. Tính định thức của ma trận bằng phương pháp Gausse.

function Determinal(var A: Mat; n: byte): real; var k: byte; t: real; Sign: Shortint;

begin

if AboveConvert(A,n, Sign) then begin t:=Sign; for k:=1 to n do t:=t*A[k,k]; Determinal:=t end else Determinal:=0 end;

procedure Solve(var A: Mat; n: byte); var k, j: byte; t: real;

begin if Determinal(A,n)<> 0 then begin MatDisplay(A,n,n+1,'A'); for k:= n downto 1 do begin t:=0; for j:=k+1 to n do t:= t+A[k,j]*A[j,n+1]; A[k, n+1]:= (A[k, n+1]-t)/A[k, k]

end end end;

TÀI LIỆU THAM KHẢO

1. Ngôn ngữ lập trình Pascal, Quách Tuấn Ngọc, NXB Giáo dục 2. Bài tập Pascal, Quách Tuấn Ngọc, NXB Giáo dục

3. Lập trình nâng cao trên ngôn ngữ Pascal, Nguyễn Tô Thành, Nhà xuất bản Đai học Quốc Gia Hà Nội.

4. Lập trình, Dự án trung học cơ sở

5. Bài tập lập trình cơ sở Ngôn ngữ Pascal, Nguyễn Hữu Ngự, NXB Đại học Quốc Gia Hà Nội

Một phần của tài liệu Ngôn ngữ lập trình Pascal ĐH Hoa Lư (Trang 131)

Tải bản đầy đủ (DOC)

(141 trang)
w