Tổng hợp bài tập môn cấu trúc dữ liệu và giải thuật bằng ngôn ngữ 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(qnil)and(p^.infoq^.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(rootnil)then begin printLNR(root^.left); write(root^.info:4); printLNR(root^.right); end; end; function Sum(root:tree;var tong:integer):integer; begin if(rootnil)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(pnil)and(p^.infox)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(pnil)and(p^.infox)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^.leftnil)then if(p^.info>q^.info)then q^.right:=p^.left else q^.left:=p^.left; if(p^.rightnil)and(p^.left=nil)then if(p^.info>q^.info)then q^.right:=p^.right else q^.left:=p^.right; if(p^.rightnil)and(p^.leftnil)then begin new(r);r:=p^.right; new(t);t:=p; while(r^.leftnil)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(rootnil)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(rootnil)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,'+',ThanhTien: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. --------------------------------------------------------------------------