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

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;

 

doc12 trang | Chia sẻ: oanh_nt | Ngày: 01/10/2013 | Lượt xem: 234 | Lượt tải: 0download
Tóm tắt tài liệu 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, để xem tài liệu hoàn chỉnh bạn click vào nút DOWNLOAD ở trê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(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. --------------------------------------------------------------------------

Các file đính kèm theo tài liệu này:

  • doctong_hop_bai_tap_mon_cau_truc_du_lieu_va_giai_thuat_bang_ngon_ngu_pascal.doc
Tài liệu liên quan