tổng hợp bài tập môn cấu trúc dữ liệu và giải thuật pascal

Sinh viên:Dương Anh Vũ
Lớp Sp Tin 2
1)
uses crt;
type
tree=^node;
node=record
info:integer;
left:tree;
right:tree;
end;
var
root:tree;x,tong,chon,sonut:integer;ch:char;
procedure Init(var root:tree);
begin
new(root);
root:=nil;
end;
procedure Add(var root:tree;x:integer);
var p,q,l:tree;
begin
new(p);
p^.info:=x;
p^.left:=nil;
p^.right:=nil;
if(root=nil)then
root:=p
else
begin
new(q);new(l);
q:=root;

while(q<>nil)and(p^.info<>q^.info)do
begin
l:=q;
if(p^.info>q^.info)then
q:=q^.right
else q:=q^.left;
end;
if(q=nil)then
if(p^.info>l^.info)then l^.right:=p
else if(p^.info<l^.info)then l^.left:=p
else if(x=q^.info)then write('da co');
end;
end;
procedure PrintLNR(root:tree);
begin
if(root<>nil)then
begin
printLNR(root^.left);
write(root^.info:4);
printLNR(root^.right);
end;
end;
function Sum(root:tree;var tong:integer):integer;
begin
if(root<>nil)then
begin
Sum:=Sum(root^.left,tong);
tong:=tong+1;
Sum:=Sum(root^.right,tong);
end;

Sum:=tong;
end;
function Find(root:tree;x:integer):boolean;
var p:tree;
begin
new(p);
p:=root;
while(p<>nil)and(p^.info<>x)do
begin
if(x>p^.info)then
p:=p^.right
else p:=p^.left;
end;
if(p=nil)then Find:=false
else Find:=true;
end;
procedure Delete(var root:tree;x:integer);
var p,q,l,r,t:tree;
begin
new(p);new(q);
q:=nil;
p:=root;
while(p<>nil)and(p^.info<>x)do
begin
q:=p;
if(x>p^.info)then
p:=p^.right
else p:=p^.left;
end;
if(p^.info=x)then

begin
if(p^.right=nil)and(p^.left=nil)then
if(x>q^.info)then q^.right:=nil
else q^.left:=nil;
if(p^.right=nil)and(p^.left<>nil)then
if(p^.info>q^.info)then
q^.right:=p^.left
else q^.left:=p^.left;
if(p^.right<>nil)and(p^.left=nil)then
if(p^.info>q^.info)then
q^.right:=p^.right
else q^.left:=p^.right;
if(p^.right<>nil)and(p^.left<>nil)then
begin
new(r);r:=p^.right;
new(t);t:=p;
while(r^.left<>nil)do
begin
t:=r;r:=r^.left;
end;
if(t^.info>r^.info)then
t^.left:=r^.right
else
t^.right:=r^.right;
p^.info:=r^.info;
end;
end;
end;
{function So_Node(root:tree;var sonut:integer):integer;
begin

if(root<>nil)then
begin
So_node:=So_Node(root^.left,sonut);
So_node:=So_node(root^.right,sonut);
if(root^.left=nil)and(root^.right=nil)then
inc(sonut);
end;
So_node:=sonut;
end;}
procedure So_Node(root:tree;var sonut:integer);
begin
if(root<>nil)then
begin
So_Node(root^.left,sonut);
So_node(root^.right,sonut);
if(root^.left=nil)and(root^.right=nil)then
inc(sonut);
end;
end;
begin
clrscr;
init(root);
repeat
writeln(' MENU');
writeln(' 1_Them ');
writeln(' 2_Tim ');
writeln(' 3_Xoa ');
writeln(' 4_TinhTong');
writeln(' 5_InCay ');
writeln(' 6_So_Nut_La');

writeln(' 7_Exit ');
Write('Ban chon:');readln(chon);
case(chon) of
1:begin
repeat
Write('Nhap phan tu can them(nhap -1 de dung):');
readln(x);
if(x<>-1)then
add(root,x);
until x=-1;
end;
2:begin
Write('nhap phan tu can tim:');
readln(x);
if(Find(root,x)=true)then
writeln('tim thay')
else writeln('khong tim thay');
end;
3:begin
write('nhap gia tri can xoa:');readln(x);
delete(root,x);
end;
4:begin
tong:=0;
writeln('Tong cay nhi phan la:',Sum(root,tong));
end;
5:begin
printLNR(root);
writeln;
end;

6:begin
sonut:=0;
so_node(root,sonut);
writeln('so nut la:',sonut);
end;
end
until chon=7;
end.
2)
Program GiaiThua;
Uses crt;
Var n: byte;
Function Giaithua(n:byte):longint;
Begin
If (n<=1) then
Giaithua:=1
Else
Giaithua:= Giaithua(n-1)*n;
End;
BEGIN
Clrscr;
Write('Nhap n: '); Readln(n);
Write(n,'!= ',Giaithua(n));
Readln;
END.

Program Fibonaci2;
Uses crt;
Var n: byte;
Function Fibonaci(n:byte):longint;

Begin
If (n<=1) then
Fibonaci:= 1
Else
Fibonaci:= Fibonaci(n-1)+Fibonaci(n-2);
End;
BEGIN
Clrscr;
Write('Nhap n: '); Readln(n);
Write('So Fibonaci thu ',n,' la: ',Fibonaci(n));
Readln;
END.

Program ThapHN3;
Uses crt;
Var n:byte;
A,B,C:char;
Procedure ThapHN(n:byte;A:char;B:char;C:char);
Begin
If n=1 then
Writeln(A,' -> ',B)
Else
Begin
ThapHN(n-1,A,C,B);
ThapHN(1,A,B,C);
ThapHN(n-1,C,B,A);
End;
End;
BEGIN
Clrscr;

Write('Nhap so dia: '); Readln(n);
Write('Nhap ten thap 1: '); Readln(A);
Write('Nhap ten thap 2: '); Readln(B);
Write('Nhap ten thap 3: '); Readln(C);
writeln('Quy trinh chuyen dia nhu sau:');
ThapHN(n,A,B,C);
Readln;
END.

program TextFile;
uses crt;
const filename='C:\Va nban.txt';
var f: text;
s: string;
chon: char;
dem: byte;
function demtu(s: string):integer;
var i,d: integer;
begin
d:=1;
for i:=1 to length(s) do
if (s[i]=' ') and (s[i+1] <> ' ') then
d:=d+1;
demtu:=d;
end;
begin
clrscr;
assign(f,filename);
{rewrite(f);
repeat

write('Nhap mot cau tho: '); readln(s);
writeln(f,s);
write('Nhap tiep hay ngung? T/N'); readln(chon);
until upcase(chon)='N';}
reset(f); {Dem so dong trong van ban tren}
{dem:=0;
while not eof(f) do
begin
readln(f,s);
dem:=dem+1;
end;
write('So dong cua van ban tren la: ',dem);
readln;}
dem:=0;
while not eof(f) do {Dem so tu trong van ban tren}
begin
readln(f,s);
dem:=dem+demtu(s);
end;
write('So tu trong van ban tren: ',dem);
readln;
close(f);
end.
3)
program ChuanHoa1;
uses crt;
var s:string;
f:text;
function ChuanHoa(var s: string):string;
const space=#32;

var i,k:byte;
begin
while s[1]=space do
delete(s,1,1);
while s[length(s)]=space do
delete(s,length(s),1);
repeat
k:=pos(space+space,s);
if k>0 then
delete(s,k,1);
until k=0;
s[1]:=upcase(s[1]);
for i:=2 to length(s) do
if s[i] in ['A' 'Z'] then
s[i]:=chr(ord(s[i])+32);
for i:=1 to length(s) do
if (s[i]=space) then
s[i+1]:=upcase(s[i+1]);
ChuanHoa:=s;
end; BEGIN
clrscr;
write('Nhap chuoi HoTen can chuan hoa: ');readln(s);
write('Chuoi sau khi chuan hoa: ',ChuanHoa(s));
assign(f,'D:\hoten.txt');
rewrite(f);
writeln(f,s);
close(f);
readln;
END.

program QuanLy2;
uses crt;
const filename='D:\DuLieu.dat';
type HangHoa= Record
MaHang:integer;
TenHang:string;
DonGia:integer;
SoLuong:integer;
ThanhTien:real;
end;
DanhSach=array[1 100] of HangHoa;
F=File of HangHoa;
var A:DanhSach;
f: F;
procedure NhapDS(var A:DanhSach; var n:integer);
var chon:char;
begin
n:=0;
repeat
n:=n+1;
with A[n] do
begin
writeln('Danh sach cac mat hang!');
write('Ma hang: ');readln(MaHang);
write('Ten hang: ');readln(TenHang);
write('Don gia: ');readln(DonGia);
write('So luong: ');readln(SoLuong);
ThanhTien:=SoLuong*DonGia;
end;
write('Nhap tiep hay ngung T\N');readln(chon);

clrscr;
until upcase(chon)='N';
end;
procedure GhiDL(var f:F;A:DanhSach;n:integer);
var i:integer;
begin
rewrite(f);
for:=1 to n do
write(f,A[i]);
end;
procedure DocDL(var f:F;A:DanhSach);
var n,i:integer;
temp:HangHoa;
begin
reset(f);
n:=0;
while not eof(f) n do
begin
n:=n+1;
read(f,A[i]);
end;
close(f);
for i:=1 to (n-1) do
for j:=i+1 to n do
if A[i].MaHang>A[j].MaHang then
begin
temp:=A[i];
A[i]:=A[j];
A[j]:=temp;
end;

rewrite(f);
for i:=1 to n do
write(f,A[i]);
close(f);
end;
procedure InDL(f:HangHoa);
var
begin
reset(f);
read(f,A);
writeln(' DANH SACH CAC MAT HANG');
writeln(' ');
write('+ STT + Ma hang + Ten hang + SoLg + Don gia + Thanh tien +');
for i:=1 to filesize(f) do
begin
read(f,A[i]);
with A[i] do

write('+',i:3,'+',MaHang:5,'+',TenHang:9,'+',SoLuong:5,'+',DonGia:7,'+',Tha
nhTien:8,'+');
end;
end;
BEGIN
clrscr;
assign(f,filename);
NhapDs(A);
GhiDl(f,A);
DocDl(A,f);
SapXep(f,A);
InDL(f);

close(f);
readln;
END.