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

{function So_Noderoot:tree;var sonut:integer:integer; begin ifrootnilthen begin So_node:=So_Noderoot^.left,sonut; So_node:=So_noderoot^.right,sonut; ifroot^.left=nilandroot^.right=n

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;

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;

{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;

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