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 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^.infop^.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 (n0 then delete(s,k,1); until k=0; s[1]:=upcase(s[1]); for i:=2 to length(s) if s[i] in ['A' 'Z'] then s[i]:=chr(ord(s[i])+32); for i:=1 to length(s) 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 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] 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 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 begin n:=n+1; read(f,A[i]); end; close(f); for i:=1 to (n-1) for j:=i+1 to n 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 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) begin read(f,A[i]); with A[i] 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