Bài tập Pascal_Phần 1

Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phn 1 1/Sắp Xếp Theo Tên: Program Sap_Xep_Theo_Ten; TYPE ConTro = ^HoSo; HoSo = RECORD HoLot : String[17]; Ten : String[7]; Diem : Real; End; VAR a : Array[1 50] Of HoSo; Tam : ConTro; i,j,PhanTu : Integer; BEGIN PhanTu := 0; New(Tam); With Tam^ Do Repeat Write('-Nhap ho lot ( 0 de ket thu): '); Readln(HoLot); If HoLot <> '0' Then Begin Write('-Nhap ten : '); Readln(Ten); Write('-Nhap diem : '); Readln(Diem); PhanTu := PhanTu + 1; a[PhanTu] := Tam^; End; Until HoLot = '0'; For i := 1 To PhanTu - 1 Do For j := PhanTu DownTo i+1 Do If a[j].Ten[1] < a[j-1].Ten[1] Then Begin Tam^ := a[j]; a[j] := a[j-1]; a[j-1] := Tam^; End; Writeln; Writeln(' '); Writeln('| HO VA TEN | DIEM |'); Writeln('| | |'); For i := 1 To PhanTu Do With a[i] Do Writeln('|',HoLot:17,' ',Ten:7,' |',Diem:5:1,' |'); Writeln(' '); Readln END. 2/Sắp xếp điểm tăng: Program Sap_Xep_Diem_Tang; TYPE ConTro = ^Lop; Lop = RECORD HoTen : String[24]; NamSinh : Integer; DiemTb : Real; End; VAR Hs : Array[1 50] Of lop; i,j,n : Integer; 1 Tam : ConTro; Begin Writeln('SAP XEP DIEM TANG DAN);'); Writeln('Giai thuat noi Buble'); Writeln(' '); New(Tam); Writeln; Write('-So hoc sinh: '); Readln(n); For i := 1 To N Do With Hs[i] Do Begin Write('+Ho ten hoc sinh thu: ',i:2,' la: '); Readln(Hoten); Write('+Nam sinh: '); Readln(NamSinh); Write('+Diem trung binh: '); Readln(DiemTb); End; For i := 1 To N-1 Do For j := 1 To N-i Do If Hs[j].DiemTb > Hs[j+1].DiemTb Then Begin Tam^ := Hs[j]; Hs[j] := Hs[j+1]; Hs[j+1] := Tam^; End; Writeln; Writeln(' DANH SACH SAP XEP'); Writeln; For i := 1 To N Do With Hs[i] Do Writeln('-',HoTen:24,' :',Namsinh:4,' , ',DiemTb:5:2); Readln End. 3/Hóa Đơn: Program Hoa_Don; CONST Max = 100; TYPE ConTro = ^HoaDon; HoaDon = RECORD NguoiMua : String[24]; TenHang : String[10]; DonGia : Real; SoLuong : Integer; End; VAR a : Array[1 Max] Of HoaDon; DsTenHang : Array[1 Max] Of String[10]; Tam : ConTro; Spt, SoTenHang, i, j : Integer; Tong : Real; KiemTra : Boolean; BEGIN Writeln('HOA DON BAN HANG'); Writeln(' '); Writeln; Spt := 0; New(Tam); With Tam^ do Repeat Write('-Ten nguoi mua (go 0 de thoat): '); 2 Readln(NguoiMua); If NguoiMua <> '0' Then Begin Write('-Ten hang: '); Readln(TenHang); Write('-Don gia : '); Readln(DonGia); Write('-So luong: '); Readln(SoLuong); Spt := Spt + 1; a[Spt] := Tam^; End; Until NguoiMua = '0'; SoTenHang := 0; For i := 1 To Spt Do Begin KiemTra :=False; For j := 1 To SoTenHang Do If DsTenHang[j] = a[i].TenHang Then KiemTra := True; If NOT KiemTra Then Begin SoTenHang :=SoTenHang + 1; DsTenHang[SoTenHang]:=a[i].TenHang; End; End; Writeln; For i := 1 To SoTenHang Do Begin Tong := 0; For j := 1 To Spt Do With a[j] Do If TenHang = DsTenHang[i] Then Tong := Tong + (DonGia * Soluong); Writeln(' +Tong so tien mua: ',DsTenHang[i]:10,' = ',tong:10:2); End; Readln END. 4/Thư viện sách: Program Thu_Vien; Uses Crt; TYPE ConTro = ^ThuVien; ThuVien = RECORD TenSach : String[30]; TacGia : String[24]; Namxb : Byte; NguoiMuon: String[24]; Next : ConTro; End; VAR First,Last,Newp : ConTro; ds,dm : Integer; Ch : Char; HeapTop : ^Integer; BEGIN ClrScr; GotoXY(5,25); Write('Bam <Enter> de tiep tuc, bam <Esc> de thoat'); Window(1,1,80,24); Writeln('QUAN LY THU VIEN'); Writeln(' '); Writeln; 3 ds := 0; dm := 0; First := Nil; Mark(Heaptop); Repeat New(Newp); With Newp^ Do Begin Write('-Ten sach : '); Readln(TenSach); If TenSach <> '' Then Begin ds := ds + 1; Write('-Tac Gia: '); Readln(TacGia); Write('-Nam xuat ban : '); Readln(Namxb); Write('-Nguoi muon (Khong co ai muon thi bam <Enter>: '); Readln(NguoiMuon); If NguoiMuon <> '' Then dm := dm + 1; End; End; If First = Nil Then First := Newp Else Last^.Next := Newp; Last :=Newp; Last^.Next := Nil; Ch := ReadKey; Until Ch = #27; ClrScr; Writeln('QUAN LY THU VIEN'); Writeln(' '); While First <> Nil Do With First^ Do Begin Writeln('-Ten sach: ',TenSach); Writeln('-Tac gia : ',TacGia); Writeln('-Nam Xuat ban: ',Namxb); Writeln('-Nguoi muon : ',NguoiMuon); First := Next; End; Writeln; Writeln('+Tong so sach: ',Ds); Writeln('+So sach cho muon: ',Dm); Release(HeapTop); Writeln; Write(' Bam <Esc> de thoat'); Readln END. 5/Hồ Sơ Nhân Viên: Program Ho_So_Nhan_Vien; Uses Crt; TYPE ConTro = ^HoSo; HoSo = RECORD HoTen : String[24]; Tuoi : Integer; Luong : LongInt; Next : ConTro; End; VAR 4 First, Last, Newp : ConTro; Hoten1, Hoten2 : String[24]; i,TuoiMax,TuoiMin : Integer; LuongMax, LuongMin,LuongTb : LongInt; Ch : Char; HeapTop :^Integer; Begin ClrScr; Writeln('HO SO NHAN VIEN'); Writeln(' '); Writeln; GoToXY(5,25); Write('Bam <Enter> de tiep tuc, bam <Esc> de thoat '); Window(1,2,80,25); First :=Nil; Mark(HeapTop); i := 0; Repeat i := i + 1; New(Newp); With Newp^ Do Begin Write('-Ho ten nhan vien thu: ',i:2,' la= '); Readln(HoTen); Write('-Tuoi = '); Readln(Tuoi); Write('-Bac luong = '); Readln(Luong); TuoiMax := Tuoi; TuoiMin := Tuoi; LuongMax := Luong; LuongMin := Luong; HoTen1 := HoTen; HoTen2 := HoTen; End; If First = Nil Then First := Newp Else Last^.Next := Newp; Last := Newp; Last^.Next := Nil; Ch := ReadKey; Until Ch = #27; Writeln; While First <> Nil Do With First^ Do Begin If Tuoi > TuoiMax Then TuoiMax := Tuoi Else If Tuoi < TuoiMin Then TuoiMin := Tuoi; If Luong > LuongMax Then Begin LuongMax := Luong; HoTen1 := HoTen; End Else If Luong < LuongMin Then Begin LuongMin := Luong; HoTen2 := HoTen; End; First := Next; End; Writeln; 5 Writeln('Nhan vien co tuoi lon nhat la: ',TuoiMax); Writeln('Nhan vien co tuoi nho nhat la:',TuoiMin); Writeln('Nhan vien: ',HoTen1,' ,co bac luong lon nhat: ',LuongMax:10); Writeln('+Nhan vien: ',HoTen2,' ,co bac luong nho nhat: ',LuongMin:10); Release(HeapTop); Writeln; Write(' Bam <Enter> de ket thuc '); Readln End. 6/Tính điểm xếp hạng: Program Tinh_Diem_Xep_Hang; TYPE ConTro = ^Lop; Lop = RECORD HoTen : String[24]; NamSinh : Integer; Tb1,Tb2,Tb : Real; End; VAR Hs : Array[1 50] Of lop; i,j,n,Hang: Integer; Tam : ConTro; Begin Writeln('TINH DIEM VA XEP HANG);'); Writeln('Giai thuat noi Buble'); Writeln(' '); Writeln; New(Tam); Write('-So hoc sinh: '); Readln(n); For i := 1 To N Do With Hs[i] Do Begin Write(' +Ho ten hoc sinh thu: ',i:2,' la: '); Readln(Hoten); Write(' +Nam sinh: '); Readln(NamSinh); Write(' +Diem trung binh hoc ky 1: '); Readln(Tb1); Write(' +Diem trung binh hoc ky 2: '); Readln(Tb2); Tb :=(Tb1 + Tb2)/2; Writeln; End; For i := 1 To N-1 Do For j := 1 To N-i Do If Hs[j].Tb < Hs[j+1].Tb Then Begin Tam^ := Hs[j]; Hs[j] := Hs[j+1]; Hs[j+1] := Tam^; End; Writeln; Writeln(' DANH SACH XEP HANG'); Writeln; Hang := 1; For i := 1 To N Do Begin If (i > 1) And (Hs[i].Tb <> Hs[i-1].Tb) Then Hang := i; Writeln(' .Hoc sinh : ',Hs[i].HoTen); Writeln(' .Nam sinh : ',Hs[i].NamSinh); Writeln(' .Diem trung binh ca nam : ',Hs[i].Tb:5:2); Writeln(' .Xep hang ca nam : ',Hang); 6 End; Readln End. 7/Hoán vị chuỗi: Program Hoan_Vi_Chuoi; Uses Crt; VAR Chuoi1,Chuoi2,Tam :^String; Begin ClrScr; Writeln('HOAN VI 2 CON TRO THAY CHO HOAN VI NOI DUNG'); Writeln(' '); Writeln; New(Chuoi1); New(Chuoi2); Chuoi1^ := 'Giao trinh Turbo Pascal 7.0'; Chuoi2^ := 'Giao trinh FoxPro 2.6'; Writeln; Writeln('NOI DUNG BAN DAU CUA 2 CHUOI'); Writeln(' '); Writeln; Writeln('-Chuoi thu nhat: ',Chuoi1^); Writeln('-Chuoi thu hai : ',Chuoi2^); Writeln; Writeln('NOI DUNG SAU KHI HOAN VI 2 CON TRO'); Writeln(' '); Writeln; Tam := Chuoi1; Chuoi1 := Chuoi2; Chuoi2 := Tam; Writeln('-Chuoi thu nhat: ',Chuoi1^); Writeln('-Chuoi thu hai : ',Chuoi2^); Dispose(Chuoi1); Dispose(Chuoi2); Writeln; Write(' Bam <Enter> . . . '); Readln; End. 8/Tách danh sách chẳn lẻ: Program Tach_Danh_Sach_Chan_Le; Uses Crt; TYPE Mang = Array[1 100] Of Integer; VAR i,j,k,n : Integer; a,b,c : Mang; Begin ClrScr; Writeln(' NHAP DANH SACH'); Writeln(' '); Write('-So phan tu: '); Readln(n); For i := 1 To n Do Begin Write('-Phan tu thu: ',i:2,' = '); Readln(a[i]); End; Writeln; Writeln('TACH THANH 2 DANH SACH'); Writeln(' '); Writeln; j := 1; k := 1; 7 For i := 1 To n Do If Odd(a[i]) Then Begin b[j] := a[i]; j := j + 1; End Else Begin c[k] :=a[i]; k := k + 1; End; Writeln; Writeln(' -Danh sach thu nhat ( so le ) '); Writeln; For i := 1 To j-1 Do Write(b[i],' '); Writeln; Writeln; Writeln(' -Danh sach thu hai ( so chan ) '); Writeln; For i := 1 To k-1 Do Write(c[i],' '); Writeln; Write(' Bam <Enter> . . . '); Readln End. 9/Đảo ngược danh sách: Program Dao_Nguoc_Danh_Sach; Uses Crt; TYPE ConTro = ^Nut; Nut = RECORD So : Integer; Next : ConTro; End; VAR Nut1,Tam1,Tam2 : ConTro; Ch : Char; BEGIN ClrScr; Writeln(' DAO NGUOC DANH SACH'); Writeln(' '); Nut1 := Nil; Repeat New(Tam1); Write('-Nhap so: '); Readln(Tam1^.So); Tam1^.Next := Nut1; Nut1 := Tam1; Write(' Nhap nua khong ? (c/k) '); Readln(Ch); Until UpCase(Ch)= 'K'; Tam1 := Nut1; Nut1 := Nil; Repeat Tam2 := Tam1^.Next; Tam1^.Next := Nut1; Nut1 := Tam1; Tam1 := Tam2; Until Tam1 = Nil; Writeln('Sau khi dao: '); Tam1 := Nut1; While Tam1 <> Nil Do Begin Write(Tam1^.So:6); Tam1 := Tam1^.Next; 8 End; Writeln; Write(' Bam <Enter> . . . '); Readln END. 10/Ghép Chuỗi: Program Ghep_Chuoi; Uses Crt; TYPE ConTro = ^Nut; Nut = RECORD Kt : Char; Next : ConTro; End; VAR Dau1,Cuoi1 : ConTro; Dau2,Cuoi2 : ConTro; Tam : ConTro; Ch : Char; i : Integer; BEGIN ClrScr; Writeln('CHUOI THU NHAT'); Writeln(' '); Writeln; i := 0; Repeat i := i + 1; New(Tam); Write('-Ky tu thu: ',i:2,' : '); Readln(Tam^.Kt); If i = 1 Then Begin Dau1 := Tam; Cuoi1 := Tam; End Else Begin Cuoi1^.Next := Tam; Cuoi1 := Tam; End; Write('Nhap nua khong ? (c/k) '); Readln(Ch); Until UpCase(Ch) = 'K'; ClrScr; Writeln('CHUOI THU HAI'); Writeln(' '); Writeln; i := 0; Repeat i := i + 1; New(Tam); Write('-Ky tu thu: ',i:2,' : '); Readln(Tam^.Kt); If i = 1 Then Begin Dau2 := Tam; Cuoi2 := Tam; End Else Begin Cuoi2^.Next := Tam; Cuoi2 := Tam; End; 9 Write('Nhap nua khong ? (c/k) '); Readln(Ch); Until UpCase(Ch) = 'K'; Cuoi1^.Next := Dau2; Cuoi2^.Next :=Nil; Writeln; Writeln(' KET QUA'); Writeln(' '); Tam := Dau1; While Tam <> Nil Do Begin Write(Tam^.Kt); Tam := Tam^.Next; End; Writeln; Write(' Bam <Enter> . . . '); Readln END. 11/Cây nhị phân (hay): Program Cay_Nhi_Phan; Uses Crt; TYPE Str = String[24]; ConTro = ^BanGhi; BanGhi = RECORD HoTen : Str; Luong : Real; Trai,Phai : ConTro; End; VAR Goc : ConTro; Nv : BanGhi; Ketthuc : Boolean; Ch : Char; { } Procedure Chen(Var Goc : ConTro; Nv : BanGhi); Var P,P1 : ConTro; Begin If goc = Nil Then Begin New(Goc); With Goc^ Do Begin HoTen := NV.HoTen; Luong := NV.Luong; Trai := Nil; Phai := Nil; End; End Else Begin P := Goc; P1 := Nil; While P <> Nil Do Begin P1 := P; If Nv.HoTen <= P^.HoTen Then P := P^.Trai Else P := P^.Phai; End; New(P); With P^ Do 10 [...]... So:=So +1; i:=i -1; End; 'V':If (i > 1) And (St[i -1] = 'I') Then Begin So:=So+4; i:=i-2; End Else Begin 24 So:=So+5; i:=i -1; End; 'X':If (i > 1) And (St[i -1] Begin So:=So+9; i:=i-2; End Else Begin So:=So +10 ; i:=i -1; End; 'L':If (i > 1) And (St[i -1] Begin So:=So+40; i:=i-2; End Else Begin So:=So+50; i:=i -1; End; 'C':If (i > 1) And (St[i -1] Begin So:=So+90; i:=i-2; End Else Begin So:=So +10 0; i:=i -1; End;... -'); Writeln; For i: =1 To n Do a[i ,1] : =1; For j: =1 To n Do a [1, j]:=0; For i:=2 To n Do For j:=2 To n Do a[i,j]:=a[i -1, j -1] +a[i -1, j]; For i: =1 To n Do Begin For j: =1 To i Do Write(a[i,j]:4); Writeln; End; Writeln; Writeln(' Bam phim de ket thuc '); Readln End 48/Phân tích số nguyên duơng nhỏ nhất: Program Phan_tich; Const n =15 ; Var a:Array [1 n, 1 n] Of Longint; i,j,i1,j1:Integer; Begin Writeln('PHAN... k:Integer; Begin na:=0; Repeat na:=na +1; Write('-Chu so thu: ',na,' = '); Readln(a[na]); Until a[na]= -1; 19 na:=na -1; For k:=0 To na -1 Do a[spt-k]:=a[na-k]; For k: =1 to spt-na Do a[k]:=0; End; { -} Procedure Cong(a:mang; Var b:mang); Var tam1,tam2,k:Integer; Begin tam1:=0; For k:= spt Downto 1 Do Begin tam2:=(a[k]+b[k]+tam1) Div 10 ; b[k]:=(a[k]+b[k]+tam1) Mod 10 ; tam1:=tam2; End; End; { ... phuong trinh: '); For i: =1 to 2 Do For j: =1 To 2 Do Begin Write('+Phan tu A[',i,',',j,']= '); Readln(a[i,j]); End; Writeln; Writeln('-Nhap cac he so C cua he phuong trinh: '); For i: =1 to 2 Do Begin Write('+Phan tu C[',i,']= '); Readln(c[i]); End; Writeln; {Giai he phuong trinh} Dt:= a [1, 1]*a[2,2]-a [1, 2]*a[2 ,1] ; {Dt: Dinh thuc} Dtx:=c [1] *a[2,2]-c[2]*a[2 ,1] ; Dty:=a [1, 1]*c[2]-a [1, 2]*c [1] ; If Dt 0 Then... DUONG NHO NHAT'); Writeln(' '); Writeln; For i: =1 To n Do For j: =1 To n Do a[i,j]:=i*i*i + j*j*j; Writeln; Writeln('IN KET QUA'); Writeln(' '); For i: =1 To n Do For j: =1 To i Do Begin For i1:= i +1 To n Do For j1: =1 To j -1 Do If a[i,j]=a[i1,j1] Then Writeln(a[i,j],' = ',i,' ^3 ',' + ',j,' ^3 ',' = ', i1,' ^3 ',' + ',j1,' ^3'); End; Writeln; Writeln(' Bam phim de ket thuc ');... For i: =1 To m Do For j: =1 To n Do Begin Write('+Phan tu B[',i,',',j,' = '); Readln(b[i,j]); End; For i: =1 To Hang1 Do For j: =1 To n Do Begin c[i,j]:=0; For q: =1 To Cot1 Do c[i,j]:= c[i,j] + a[i,q] * b[q,j]; End; For i: =1 to hang1 Do Begin For j:= 1 To n Do Write((c[i,j]):8); Writeln; End; Readln End 27/Tìm và xóa các kí tự trùng nhau trong chuổi: Program Tim_Xoa; Var St,St1:String; Ch:Char; i,l,l1:Byte;... Write('-Mang con lai: '); For i: =1 to n Do Write(a[i]:8); Writeln; Writeln(' Bam phim de ket thuc '); Readln End 45/Dãy con: Program Day_con; Const k =10 ; a:Array [1 k] Of Integer= (1, 3,2,8 ,10 ,12 ,7,29,6,3); Var 34 i:Integer; vt,max:Integer; n,tong:Integer; Begin Vt: =1; max:=a [1] ; n: =1; tong:=a [1] ; For i:=2 To k Do Begin If (a[i] > a[i -1] ) Then tong:=tong+a[i]; If (a[i] < a[i -1] ) Or (i=k) Then Begin If... Integer; so,vt1,vt2,i:Integer; Begin Writeln('GIAI THUAT TIM KIEM NHI PHAN'); Writeln(' '); Writeln; For i: =1 To N Do Begin Write('-Phan tu A[',i,']= '); Readln(a[i]); End; Writeln; Write('-So can tim: '); Readln(so); vt1: =1; vt2:=n; While vt2 >= vt1 Do Begin i:=Trunc((vt1+vt2) Div 2); 33 If so > a[i] Then vt1:=i +1 Else If so < a[i] Then vt2:=i -1 Else vt2:= -1; End; If vt2 = -1 Then Writeln('+Tim... k:=spt-na +1 To spt Do Write(a[k],' '); Writeln; Write('*So thu hai : '); For k:=spt-nb +1 To spt Do Write(b[k],' '); Writeln; Write('*Tich = '); For k:=Spt-(na+nb) +1 To spt Do Write(kq[k],' '); Writeln; Writeln(' Bam phim de ket thuc '); Readln END 23/Ma trận vuông 10 x10 phần tử: 20 Program Ma_tran_vuong; Uses Crt; Var a:Array [1 10, 1 10] Of Integer; i,j:Integer; Begin Writeln('MA TRAN VUONG 10 x 10 ... Program Doi_he_2; Const KyTuHe2:array[0 1] Of Char =' 01' ; Var SoWord:Word; SoBinary:String [16 ]; i:byte; Begin Writeln('DOI SO NGUYEN KIEU WORD RA HE NHI PHAN'); Writeln(' '); Writeln; Write('-Nhap so kieu Word: '); Readln(SoWord); SoBinary[0]:= #16 ; For i: =15 DownTo 0 Do If (SoWord AND (1 SHL i)) = (1 SHL i) Then SoBinary [16 -i]:= KyTuHe2 [1] Else SoBinary [16 -i]:= KyTuHe2[0]; Writeln('+So nguyen . Tam1^.Next := Nut1; Nut1 := Tam1; Tam1 := Tam2; Until Tam1 = Nil; Writeln('Sau khi dao: '); Tam1 := Nut1; While Tam1 <> Nil Do Begin Write(Tam1^.So:6); Tam1 := Tam1^.Next; 8 . Readln(Tam1^.So); Tam1^.Next := Nut1; Nut1 := Tam1; Write(' Nhap nua khong ? (c/k) '); Readln(Ch); Until UpCase(Ch)= 'K'; Tam1 := Nut1; Nut1 := Nil; Repeat Tam2 := Tam1^.Next; . Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phn 1 1/Sắp Xếp Theo Tên: Program Sap_Xep_Theo_Ten; TYPE ConTro = ^HoSo; HoSo = RECORD HoLot : String [17 ]; Ten : String[7]; Diem