Hoán vị ma trận thưa

Program hv;

Var m,n,i,j,k,q,hang,cot:integer;

a,b:array[1..100,1..3] of integer;

f,f1:file of integer;

chon:char;

begin

writeln('nhap ma tran A');

write('so hang(m) :')

readln(m);

write('so cot(n):');

readln(n);

write('so phan tu khac 0(q) :');

readln(q);

a[1,1]:=m; a[1,2]:=n; a[1,3]:=q;

for i:=2 to q+1 do

begin

write('a[',i,'1]= ');readln(a[i,1]);

write('a[',i,'2]= ');readln(a[i,2]);

write('a[',i,'3]= ');readln(a[i,3]);

end;

writeln('hoan vi ma tran:');

b[1,2]:=m; b[1,1]:=n; b[1,3]:=q;

k:=2;

for cot:=1 to n do {n ở đây là 3}

for hang:=2 to q+1 do

if a[hang,2] = cot then

begin b[k,1] := a[hang,2];

b[k,2] := a[hang,1];

b[k,3] := a[hang,3];

k:=k+1

end;

writeln('hien ket qua hoan vi:');

for i:=1 to q+1 do

begin

for j:=1 to 3 do

write('!',b[i,j],'!');

writeln;

end;

readln;

end.

Thư viện ngăn xếp STACK

Tệp stack.tpu

UNIT STACK;

INTERFACE TYPE

StackElement=integer;

PointerType=^StackNode;

StackNode=record

Du_Lieu: StackElement;

Next: PointerType;

end;

StackType= PointerType;

Procedure CreateS(Var Stack: StackType);

Function EmptyS(Stack: StackType):Boolean;

Procedure PoP(Var Stack: StackType;var Item:StackElement);

Procedure Push(Var Stack: StackType; Item:StackElement);

IMPLEMENTATION

Procedure CreateS(Var Stack: StackType); (*tạo ngăn sếp rỗng*);

Begin Stack:= Nil end;

Function EmptyS(Stack: StackType):Boolean;

Begin EmptyS:= (Stack = Nil) end;

Procedure Push(Var Stack: StackType;Item:StackElement);

(*đẩy item vào ngăn xếp*)

Var TempPtr:PointerType;

Begin

New(TempPtr);

TempPtr^.Du_Lieu:=Item;

TempPtr^.Next:= Stack;

Stack:=TempPtr;

End;

Procedure Pop(Var Stack: StackType; Var Item:StackElement);

(* lấy item ra từ đỉnh ngăn xếp Stack*)

Var TempPtr:PointerType; (* TempPtr - con trỏ tạm thời chỉ đến nút đỉnh Stack *)

Begin

If EmptyS(Stack) then halt

Else

Begin Item:= Stack^.Du_Lieu;

TempPtr:=Stack;

Stack:= Stack^.Next;

Dispose(TempPtr);

End;

End(*pop*);

End.

Ví dụ ngăn sếp Stack:

Bài toán đổi cơ số 10 sang cơ số 2:

Program doicoso;

Uses dos;

const stacklimit=50;

type Kieu_Ptu=integer;

Day_Nganxep=array[1..stacklimit] of Kieu_Ptu;

Kieu_Nganxep= record

top:0..stacklimit;

phantu:Day_Nganxep;

end;

var so,sodu:integer;

stack: Kieu_Nganxep;

traloi: char;

procedure thietlap(Var stack : Kieu_Nganxep);

begin stack.top :=0

end;

function IsEmpty(stack : Kieu_Nganxep) :boolean;

begin IsEmpty := (stack.top = 0) end;

procedure Top(var stack :Kieu_Nganxep; var Item : Kieu_Ptu);

begin if IsEmpty(stack) then halt

else with stack do

begin Item := Phantu[top];

top :=top - 1

end

end;

procedure Them(var stack :Kieu_Nganxep; Item : Kieu_Ptu);

begin if stack.top = stacklimit then halt

else with stack do

begin top := top+1;

phantu[top] := Item

end

end;

begin (*chuong trinh chinh *)

repeat

write('dua vao so can doi :');

readln(so);

thietlap(stack);

while so <> 0 do

begin sodu := so mod 2;

them(stack,sodu);

so := so div 2

end;

writeln('bieu dien co so 2 :');

while not IsEmpty(stack) do

begin top(stack, sodu);

write(sodu:1);

end;

readln;

write('co lam tiep ko? (y/n)');

readln(traloi);

until not (upcase (traloi) = 'Y')

end.

Thư viện hàng đợi QUEUE

thủ tục thiết lập hàng đợi:

Procedure CREATEQ(var Q: array[1..n] of item; {n là const}

front, rear: 0..n;

Begin front:=0; rear:=0 end;

kiểm tra hàng có rỗng ko:

Function ISEMPTY(Q);

Begin

ISEMPTY:= (front = rear);

end;

cho phần tử ở đầu của hàng đợi:

procedure FRONT(Q);

begin if ISEMPTY then Halt

else front:= front +1

end;

thủ tục thêm phần tử vào hàng đợi

procedure ADDQ(item: Kieu_Ptu);

begin if rear =n then

writeln('hàng đầy');

else begin

rear:= rear +1;

Q[rear]:= item;

end;

end;

lấy phần tử ra khỏi hàng đợi:

procedure DELETEQ(var item: Kieu_Ptu);

begin if front = rear then(* hàng rỗng*) Halt Else

begin

front:= front + 1;

Item:= Q[front];

end;

end;

tệp queue.pas

UNIT QUEUE;

INTERFACE TYPE

QueueElement=integer;(*co the thay doi*)

QueuePtr=^QueueNode;

QueueNode=record

Du_Lieu: QueueElement;

next: QueuePtr;

end;

QueueType= record

front, rear : QueueType;

end;

procedure CreateQ(var Queue : QueueType);

Funtion EmptyQ(Queue : QueueType) :boolean;

procedure AddQ(var Queue: QueueType; Item: QueueElement);

procedure RemoveQ(var Queue: QueueType; var Item:QueueElement);

IMPLEMENTATION

procedure CreateQ(var Queue: QueueType);

begin Queue.front := Nil;

Queue.rear := Nil;

end;

function EmptyQ(Queue : QueueType) :boolean;

begin EmptyQ:= (Queue.front = Nil) and (Queue.rear = Nil) end;

procedure AddQ(var Queue: QueueType; Item:QueueElement);

var Pt: QueuePtr;

begin

New(Pt);

Pt^.Du_Lieu := Item;

With Queue Do

if EmptyQ(Queue) then

Begin

front := Pt;

rear := Pt

end

else

begin rear^.next := Pt;

rear := Pt

end;

end;

procedure RemoveQ(var Queue: QueueType; var Item:QueueElement);

var Pt: QueuePtr;

begin

if EmptyQ(Queue) then writeln('hang doi rong')

else WITH Queue DO

begin Item:= front^.Du_Lieu;

Pt := front;

if front <> rear then

front :=front^.next

else begin front := Nil;

rear :=Nil

end;

Dispose(Pt);

end;(*WITH*)

end; (* removeQ*);

end.

Ví dụ áp dụng: giả thiết đã tạo 2 thư viện Stack.tpu và Queue.tpu, dùng các phép toán cơ bản của 2 thư viện trên để viết thủ tục đảo ngược các phần tử của hàng đợi

uses STACK, QUEUE;

procedure taohangdoi (var Q:QueueType);

var i:integer;

begin CreateQ(Q);

writeln('dua vao cac so nguyen:');

while not eoln Do

begin

read(i);

AddQ(Q,i)

end;

readln;

end;

var Q: QueueType;

S: StackType;

x: Integer;

begin taohangdoi(Q);

CreateS(S);

while not EmptyQ(Q) do

begin RemoveQ(Q,x);

Push(S,x)

end;

while not EmptyS(S) Do

begin Pop(S,x);

AddQ(Q,x);

write(x,' ')

end;

readln;

end.

thuật toán sắp xếp:

1.đơn giản cho

a. mảng

for i:=1 to n-1 do

for j:=i+1 to n do

if x[j]< x[i] then

begin

x[i]:=x[i] +x[j];

x[j]:=x[i] - x[j];

x[i]:=x[i] - x[j];

end;

b. cho danh sách liên kết

2. nổi bọt- sắp xếp dần

program sapxep_noibot;

uses Wincrt;

var i,j,n,k:integer;

a:array[1..50] of real;

tg:real;

begin write('nhap N:');

readln(N);

for i:=1 to n dp

begin write('nhap a[',i,']=');

readln(a[i])

end;

for i:=1 to n do

for j:=1 to n-i do

if a[j]> a[j+1] then

begin tg:=a[j];

a[j]:=a[j+1];

a[j+1]:=tg

end;

for i:=1 to n do

writeln(a[i]:8:8,' ');

end.

3. sắp xếp chèn

giải thích sơ đồ thuật toán:

b1:khởi động: x[0] tại giá trị -∞.

như vậy x[i] >= x[0] với mọi i

b2:

for i:=2 to n do

begin r := x[i];

j:=i-1;

while r< x[j] do

begin

x[j+1] := x[j]; {chuyển dịch sang phải tạo ô trống}

j := j-1 { giảm j để xét phần tử trước đó}

end;

x[j+1] := r; { chuyển r vào ô trống}

end;

bài tập du lịch

program bai_tap_du_lich;

const f1 = 'điadiem.txt';

f2= 'khach.txt';

f3= 'ketqua.txt';

var h1: array[1..100] of string[30];

h2: array[1..100] of integer;

h3: array[1..100,1..15] of integer;

i,j,n,t,tg : integer;

tgd: string[30];

f : text;

begin

assign(f,f1);reset(f);

i:=1

while not eof(f) do

begin

readln(f,h1[i]);

i:= i+1;

end;

n:= i-1;

close(f);

assign(f,f2);reset(f);

for i:=1 to n do

begin

t:=0;

for j:=1 to 12 do

begin

read(f,h3[i,j]);

t:= t + h3[i,j];

end;

h2[i]:=t;

end;

close(f);

for i:=1 to n do

for j:=1 to n-1 do

if (h2[j]>h2[j+1]) then

begin

tg:= h2[j];

h2[j]:= h2[j+1];

h2[j+1]:=tg;

tgd:= h1[j];

h1[j]:= h1[j+1];

h1[j+1]:= tgd;

end;

assign(f,f3);rewrite(f);

for i:=1 to n do

begin

write(f,h1[i],' ');

writeln(h2[i]);

end;

readln;

end.