Giáo trình Tin học đại cương - Nguyễn Gia Phúc

 để ghi dữ liệu, trong đó mỗi bản ghi của FA chưa ba dữ liệu 
thực , mỗi bản ghi của FB chứa một dữ liệu nguyên và một dữ liệu xâu kí tự . Các dữ liệu sẽ 
được đưa vào từ bàn phím. 
 b) Tạo file FS từ FA và FB sao cho mỗi bản ghi của FS được tạo bằng cách ghép các 
bản ghi tương ứng của FA, FB .Nếu các file FA , FB có số lượng bản ghi khác nhau thì bỏ 
phần dư của một trong hai file đó . 
 c) Đưa các bản ghi FS ra màn hình. 
Program c9b9; 
Uses crt; 
type ra = record 
 x1 , x2 , x3 ::real ; 
 end; 
 rb = record 
 n1:integer; 
 s1 :string; 
 end; 
 rc = record 
 x1 , x2 , x3 : real; 
 n1 : integer; 
 s1 : string; 
 end; 
Var i : integer; 
 ba : ra; 
 bb : rb; 
 bc : rc; 
 f1 : file of ra; 
 f2 : file of rb; 
 f3 : file of rc; 
 ans: char; 
BEGIN clrscr; 
assign (f1,' FA '); 
rewrite(f1); 
writeln(' Nhap du lieu cho file FA : '); 
repeat 
 write(#13#10 ' Cho 3 so thuc :'); 
 readln(ba.x1,ba.x2,ba.x3); 
 write(f1,ba); 
 repeat 
 write (' Co nhap tiep du lieu cho file FA nua khong ?(C/K)'); 
 138
 Nguyễn Gia Phúc, Nguyễn Thái Hà Giáo 
 trình Tin họcđạicương 
 ans :=upcase ( readkey ); 
 until ans in ['C' , 'K']; 
until ans= 'K'; 
close (f1); 
assign (f2,' FB '); 
rewrite(f2); 
writeln(#13#10' Nhap du lieu cho file FB : '); 
repeat 
 write(#13#10 ' Cho so nguyen va mot xau :'); 
 write ( ' n = '); readln(bb.n1); 
 write ( ' xau : '); readln (bb.s1); 
 write(f2,bb); 
 repeat 
 write (' Co nhap tiep du lieu cho file FB nua khong ?(C/K)'); 
 ans :=upcase ( readkey ); 
 until ans in ['C' , 'K']; 
until ans= 'K'; 
close (f2); 
assign (f3,'FC '); 
rewrite(f3); i:=0; 
assign(f1,'FA'); reset(f1); 
assign(f2,'FB'); reset(f2); 
while (not eof(f1)) and not(eof(f2)) do 
 begin 
 read(f1,ba); read(f2,bb); 
 bc.x1:=ba.x1; bc.x2:=ba.x2; bc.x3:=ba.x3; 
 bc.n1:=bb.n1; bc.s1:=bb.s1; 
 write(f3,bc); inc(i); 
 with bc do 
 begin 
 writeln(#13#10 '***** Ban ghi thu ' , i ,' :'); 
 writeln('x1 , x2 , x3 = ', x1:12:3,x2:12:3, x3:12:3); 
 writeln(' n = ',n1); 
 writeln(' Xau : ' ,s1); 
 delay(1000); 
 end; 
 end; 
close(f1); close(f2); close(f3); 
END. 
Bài 10 : Hãy lập chương trình làm các việc sau : 
 a) Tạo một file , mỗi bản ghi gồm : 
 - Tên sản phẩm : xâu < 21 kí tự 
 - Mã sản phẩm : gồm 2 mã , mỗi mã là một số nguyên. 
 - Đơn giá : số thực 
Tên file đọc từ bàn phím và kết thúc vào dữ liệu khi gặp tệp rỗng . 
 b) Cập nhật đơn giá sản phẩm của thông tin ghi trên file dựa theo mã thứ 2 và đơn giá 
sản phẩm tương ứng. Nếu ặp mã mới thì thông báo và bỏ qua. 
Chương 10 : Thủ tục , hàm ,chương trình pascal có cấu trúc 
 139
 Nguyễn Gia Phúc, Nguyễn Thái Hà Giáo 
 trình Tin họcđạicương 
Bài 1 : Lập chương trình tính min/max của một hàm số trên đoạn [a , b] bằng cách dùng thủ 
tục và hàm . Các giá trị a và b đưa vào từ bàn phím , tìm min hay max tuỳ chọn. 
Program c10b1; 
Uses crt; 
Var a , b , ketqua : real ; 
 chon : integer; 
Procedure menu; 
begin 
 writeln(' ***** TIM MIN/MAX HAM SO *****'); 
 writeln(' 1- Tim min f(x) '); 
 writeln(' 2- Tim max f(x) '); 
 writeln(' 3- Ket thuc '); 
 writeln('-----------------------'); 
 writeln(' An so de chon ! '); readln(chon); 
end; {Menu} 
Function f(x:real): real; 
begin 
 f:=x*x - 5*x + 6 ; 
end; 
Procedure minf(aa,bb:real; var mi:real); 
Var x , dx : real; 
 i : integer; 
Begin 
 mi := 1e10; dx:=(bb-aa)/200; 
 for i:=1 to 200 do 
 begin 
 x:=aa+(i-1)*dx; 
 if f(x) <mi then mi:=f(x); 
 end; 
end; {minf} 
Procedure maxf(aa,bb:real; var ma :real); 
var x , dx : real; 
 i : integer; 
Begin 
 ma:=-1e10; dx:=(bb-aa)/200; 
 for i:=1 to 200 do 
 begin 
 x:=aa+(i-1)*dx; 
 if f(x)>ma then ma:=f(x); 
 end; 
End; {maxf} 
Procedure thongbao; 
Begin 
 gotoxy(50,15); 
 writeln('* An ENTER de tiep tuc !'); 
 repeat until keypressed; 
end; { thong bao } 
BEGIN 
clrscr; 
 140
 Nguyễn Gia Phúc, Nguyễn Thái Hà Giáo 
 trình Tin họcđạicương 
menu; 
while chon 3 do 
 begin 
 writeln; 
 write(' a, b ='); readln(a, b); 
 if chon=1 then minf(a,b,ketqua); 
 if chon=2 then maxf(a,b,ketqua); 
 writeln(' ket qua =',ketqua:16:2); 
 thongbao; 
clrscr; menu; 
 end; 
END. 
Bài 2 : Lập chương trình nhập toạ độ n điểm trong không gian (x1 , y1 , z1) rồi tìm toạ độ các 
đỉnh của một hình hộp có các cạnh song song với các trục toạ độ và chứa tất cả các điểm trên . 
Program c10b2; 
Uses crt; 
Type vt = array[1..100] of real; 
Var n:type 
 x, y, z: vt; 
 xl,yl,zl,xn,yn,zn :real; 
Procedure Nhap; 
Var i:byte; 
Begin 
repeat 
 write('#13#10' Tong so diem :'); 
 readln(n); 
until (n>0) and (n<100); 
writeln('Nhap toa do cac diem :'); 
for i :=1 to n do 
 begin 
 write('X[', i ,'] , y[', i ,'] : '); 
 readln(x[i], y[i],z[i]); 
 end; 
End; {end of NHAP} 
Procedure minmax(var w:vt; var v1,v2:real); 
Var i:byte; 
Begin 
v1:= w[1]; 
v2:=v1; 
for i:=1 to n do 
 if w[i] <v1 then v1:=w[i] 
 else if w[i]>v2 then v2:=w[i]; 
end; {end of MINMAX} 
BEGIN 
clrscr; 
nhap; 
minmax(x,xn,xl); 
minmax(y,yn,yl); 
minmax(z,zn,zl); 
 141
 Nguyễn Gia Phúc, Nguyễn Thái Hà Giáo 
 trình Tin họcđạicương 
writeln(' Toa do hai dinh xac dinh hop can tim la :'); 
writeln(' Dinh duoi ben trai : x = ',xn :6:2,' y=',yn:6:2,'z=',zn:6:2); 
writeln('Dinh tren ben phai : x= ',xl:6:2, 'y= ' ,yl:6:2,' z=',zl:6:2); 
repeat until keypressed 
END. 
Bài 3 : Lập thủ tục đổi các toạ độ tương ứng của hai vectơ a ,b cho nhau. 
Procedure swap(var a, b :vt; n: integer); 
Var i: integer; 
 r : real; 
Begin 
 for i:=1 to n do 
 begin 
 r:=b[i]; 
 b[i]:=a[i]; 
 a[i]:=r; 
 end; 
End; 
Bài 4 : Cho hai ma trận A, B có cùng kích thước . Lập một thủ tục đổi chỗ các phần tử tương 
ứng của A và B cho nhau. Đưa ra màn hình A , b ban đầu và sau khi đã đổi chỗ. 
Bài 5 : Lập thủ tục tính tích hai ma trận , thủ tục chuyển vị ma trận . Dùng các thủ tục này lập 
chương trình đọc vào ma trận A kích thước m , n rồi tính A.A* trong đó A* là chuyển vị của 
A. 
Bài 6 : Lập thủ tục kiểm tra xem xâu A có chứa xâu B như một xâu con hay không và nếu có 
thì xem chứa bao nhiêu lần . 
Program c10b6; 
Uses crt; 
Var a, b, c , d : string; 
 k , l, i , j ; byte; 
BEGIN 
clrscr; 
write (' Xau A : '); readln(a); 
write (' Xau B : '); readln(b); 
c:=a; k:=0; l:=length(b); d: =' ' ; j:=pos(b,c); 
d := chr(219); { ''} 
while j>0 do 
 begin 
 inc(k); 
 delete(c,j,1); 
 insert(d,c,j); 
 j:=pos(b,c); 
 end; 
if k = 0 then writeln(' Xau ' , a , ' Khong chua xau ', b , '. ') 
else 
 writeln(' Xau ' ' , b , ' ' ' co mat trong xau ' ' ' , a , ' ' ' ', k , ' lan . '); 
readln; 
END. 
Bài 7 : a) Lập hàm xác định chỉ số kể từ đó xây B tham gia vào xâu A như một xâu con lần 
thứ k. 
 142
 Nguyễn Gia Phúc, Nguyễn Thái Hà Giáo 
 trình Tin họcđạicương 
 b) Viết chương trình dùng hàm trên để tìm chỉ số của xâu A mà từ chỉ số đó xâu B 
tham gia vào xâu A như một xâu con lầ thứ k . Các xâu A , B và số k nhập từ bàn phím. 
Function indxk(a , b : string; k :byte) :byte; 
Var i , j , l : byte; 
 c , d :string; 
 ok:boolean; 
Begin 
 c:=a; l:=length(b); d:=' '; 
 d := chr (219); 
 i:= pos (b , c); j:=1; 
 ok:=(i>0) and (j=k); 
 while (i>0) and (j<k) do 
 begin 
 inc(j); 
 delete(c,i,1); 
 insert(d, c, i); 
 i:=pos(b,c); 
 ok:=(i>0) and (j=k); 
 end; 
 if ok then indxk:=i else indxk:=0; 
End; { het ham INDXK } 
Program c10b13; 
Uses crt; 
Var a,b : string; 
 k: byte; 
Function indxk(a , b : string; k :byte) :byte; 
Var i , j , l : byte; 
 c , d :string; 
 ok:boolean; 
Begin 
 c:=a; l:=length(b); d:=' '; 
 d := chr (219); 
 i:= pos (b , c); j:=1; 
 ok:=(i>0) and (j=k); 
 while (i>0) and (j<k) do 
 begin 
 inc(j); 
 delete(c,i,1); 
 insert(d, c, i); 
 i:=pos(b,c); 
 ok:=(i>0) and (j=k); 
 end; 
 if ok then indxk:=i else indxk:=0; 
End; { het ham INDXK } 
BEGIN 
clrscr; 
write(' Xau A : '); readln(a); 
write(' Xau B : '); readln(b); 
write(#13#10'K = ' ); readln(k); 
 143
 Nguyễn Gia Phúc, Nguyễn Thái Hà Giáo 
 trình Tin họcđạicương 
writeln(indxk(a,b,k); 
readln; 
END. 
Bài 8 : a) Lập thủ tục biến đổi các kí tự của xâu A theo qui tắc sau : Nếu kí tự thứ i ( 1 i 
length(A) Ai có mặt trong xâu B thì nó được thay thế bằng kí tự tương ứng ở xâu C ( các xâu 
B, C có độ dài bằng nhau và bằng m ). Các kí tự Ai không có mặt rong B được giữ nguyên. 
 b) Lập chương trình nhập cá xâu A , B , C từ bàn phím rồi sử dụng thủ tục trên biến 
đổi xâu A theo qui tắc đã nêu . Đưa kết quả ra màn hình. 
Program translate(var a, b , c : string ; m : byte); 
Var i , j : byte; 
Begin 
for i:=1 to length(a) do 
 begin 
 j:= pos(a[i], b); 
 if j>0 then a[i] :=c[j]; 
 end; 
End; 
Program c10b8; 
Uses crt; 
Var s1 , s2 , s3 : string ; 
 ans:char; 
 n:byte; 
Program translate(var a, b , c : string ; m : byte); 
Var i , j : byte; 
Begin 
for i:=1 to length(a) do 
 begin 
 j:= pos(a[i], b); 
 if j>0 then a[i] :=c[j]; 
 end; 
End; 
BEGIN 
clrscr; 
repeat 
 write(#13#10' Xau nguon :'); readln(s1); 
 repeat 
 write(' Xau khoa :'); readln(s2); 
 write( 'Xau thay :'); readln(s3); 
 n:=length(s2); 
 until n = length(s3); 
 translate(s1,s2,s3,n); 
 writeln(' Ket qua thay the :',s1); 
 repeat 
 write(#13#10' Co lam tiep nua khong ?(C/K)'); 
 ans:=upcase(readkey); 
 until ans in [' C ' , ' K ']; 
until ans='K' 
END. 
 144
 Nguyễn Gia Phúc, Nguyễn Thái Hà Giáo 
 trình Tin họcđạicương 
Bài 9 : Lập thủ tục viết một câu vào vị trí (x , y) và thủ tục xoá câu từ vị trí (x , y) trở đi , 
trong đó (1 x 80 , 1 y 25). Dùng các thủ tục đã viết lập chương trình để cho dòng chữ 
** DAI HOC BACH KHOA HA NOI ** chạy trên màn hình từ trái sang phải , roòi chạy trên 
đường chéo màn hình. 
Program DEMO; 
Uses crt; 
Const 
 a= ' DAI HOC BACH KHOA HA NOI'; 
 b= ' KHOA TIN HOC ' ; 
 c= "PHONG MAY TINH'; 
Procedure writeXY ( x , y : integer; st : string); 
Begin 
 gotoxy(x,y); write(st); 
End; 
Procedure delxy( x , y : integer); 
Var i: integer; 
Begin 
 gotoxy(x , y); 
 for i:=x to 80 do write(' '); 
end; {delxy} 
Procedure qc1(st : string); 
Var k , x , y : integer; 
Begin 
 for k:=25 to 75 do 
 begin 
 x:=80-k; y:=10; 
 writexy(x,y,st); delay(100); 
 delxy(x , y); 
 if keypressed then exit; 
 end; 
End; {qc1} 
Procedure qc2(st : string); 
Var k , x , y : integer; 
Begin 
 for k:=1 to 64 do 
 begin 
 x:=65-k; y:=(25- (k div 3)); 
 writexy(x,y,st); delay(100); 
 delxy(x , y); 
 if keypressed then exit; 
 end; 
End; {qc2} 
 { chuong trinh chinh } 
BEGIN 
textbackground(1); 
clrscr; 
writexy(2,2,'An ENTER de ketthuc !'); 
textcolor(3); 
repeat 
 145
 Nguyễn Gia Phúc, Nguyễn Thái Hà Giáo 
 trình Tin họcđạicương 
 qc1(a); qc2(a); qc1(b); qc2(b); qc1(c); qc2(c); 
until keypressed; 
END. 
Bài 10 : Lập thủ tục Di : Đổi dấu tất cả các phần tử trên dòng i của ma trận A ; Thủ tục Cj : 
Đổi dấu tất cả các phần tử trên cột j của ma trận A ; Lập chương trình dùng các thủ tục trên để 
biến đổi ma trận A thành ma trận có tổng các phần tử cùng dòng hoặc cùng cột không âm. 
Program c10b10; 
Uses crt; 
Var q:array[1..20,1..40] of real; 
 i , j , m , n : integer; 
 ok : boolean; 
Function d(i:integer):real; 
Var j:integer; 
 s:real; 
Begin 
 s:=0; 
 for j:=1 to n do s:=s+q[i,j]; 
 d:=s; 
End; {End of function D(i). } 
Function c(j:integer):real; 
Var i:integer; 
 s:real; 
Begin 
 s:=0; 
 for i:=1 to m do s:=s+q[i,j]; 
 c:=s; 
End; {End of function C(j). } 
Procedure sc(j:integer); 
{ Doi dau cot j } 
Var i:integer; 
Begin 
 writeln(' Doi dau dong',j); 
 delay(500); 
 for i:=1 to m do q[i,j]:=-q[i,j]; 
End; { End of Procedure sc(i). } 
Procedure sd(i:integer); 
{ Doi dau hang i } 
Var j:integer; 
Begin 
 writeln(' Doi dau dong',i); 
 delay(500); 
 for j:=1 to n do q[i,j]:=-q[i,j]; 
End; { End of Procedure sd(i). } 
BEGIN 
clrscr; 
write(#13#10 ' M ,N ='); readln(m,n); 
writeln( ' Nhap mang Q :'); 
for i:=1 to m do 
 for j:=1 to n do 
 begin 
 write('Q[' , i , ',' , j , ']='); 
 146
 Nguyễn Gia Phúc, Nguyễn Thái Hà Giáo 
 trình Tin họcđạicương 
 readln(q[i,j]); 
 end; 
ok:=false; 
while not ok do 
 begin 
 ok:=true; 
 for i:=1 to m do if (d(i) <0 ) then 
 begin sd(i); ok :=false; end; 
 for j;=1 to n do if (c(j) < 0 ) then 
 begin sc(j); ok:=false; end; 
 end; 
writeln(' Ket qua : '); 
for i:=1 to m do 
 for j:=1 to n do 
 writeln(' Q[' , i , ',' , j , ']=' , q[i,j]:6:2); 
readln; 
END. 
Bài 11 : Lập chương trình nhập một văn bản T, đếm các kí tự khác nhau và số lần xuất hiện các kí 
tự đó trong T , tính tỷ số giữa số lần xuất hiện từng kí tự và độ dài văn bản T. Hiển thị trên màn 
hình hoặc in ra máy in tuỳ chọn. 
Program c10b11; 
Uses crt,printer; 
Var t:array[1..10000] of char; 
 s1:array[char] of integer; 
 i, ans : char; 
 n : integer; 
BEGIN 
 repeat 
 clrscr; 
 for i:=chr(0) to chr(255) do s1[i]:=0; 
 gotoxy(1,1); 
 write(' Van ban vao :'); gotoxy(21,24); 
 write(' Ket thuc van ban vao : An Ctrl +Z. '); 
 window(0,0,80,22); 
 gotoxy(15,1); n:=0; 
 repeat 
 ans:=readkey; write(ans); 
 inc(n); 
 t[n]:=ans; 
 s1[ans]:=s1[ans]+1; 
 until ord(ans) =26; 
 dec(n); 
 repeat 
 writeln; 
 write(' Dua ket qua ra dau ? (S: Man hinh, P : May in).'); 
 ans:=upcase(readkey); 
 until ans in [' S ' , ' P ']; 
 writeln; 
 Case ans of 
 'S' : if n=0 then writeln(' Van ban trong !') 
 else 
 147
 Nguyễn Gia Phúc, Nguyễn Thái Hà Giáo 
 trình Tin họcđạicương 
 for i:=chr(0) to chr(255) do 
 if (s1[i]0) and 9ichr(26)) then 
 writeln(i:3,' Tan so : ',s1[i]:6,' Tan suat :' ,s1[i]/n:10:8); 'P': if n=0 then 
writeln(lst, 'Van ban trong!') 
 else 
 for i:=chr(0) to chr(255) do 
 if (s1[i]0) and 9ichr(26)) then 
 writeln(i:3,' Tan so : ',s1[i]:6,' Tan suat :' ,s1[i]/n:10:8); 
 end; 
 repeat 
 write(#13#10' Co lam tiep nua khong ? (C/K)'); 
 ans:=upcase(readkey); 
 until ans in [' C ' , ' K '] 
until ans='K'; 
END. 
 PHỤ LỤC 
 BẢNG MÃ CHUẨN ASCII 
 Số TT Ký tự Số TT Ký tự Số TT Ký tự Số TT Ký tự 
 0 NUL 32 Space 64 @ 96 ` 
 1 SOH 33 ! 65 A 97 a 
 2 STX 34 “ 66 B 98 b 
 3 ETX 35 # 67 C 99 c 
 4 EOT 36 $ 68 D 700 d 
 5 ENQ 37 % 69 E 101 e 
 6 ACK 38 & 70 F 102 f 
 7 BEL 39 ‘ 71 G 103 g 
 8 BS 40 ( 72 H 104 h 
 9 HT 41 ) 73 I 405 i 
 10 LF 42 * 74 J 106 j 
 11 VT 43 + 75 K 107 k 
 12 FF 44 , 76 L 108 l 
 13 CR 45 - 77 M 109 m 
 14 SO 46 . 78 N 110 n 
 15 SI 47 / 79 O 111 o 
 16 DLE 48 0 80 P 112 p 
 17 DC1 49 1 81 Q 113 q 
 18 DC2 50 2 82 R 114 r 
 19 DC3 51 3 83 S 115 s 
 20 DC4 52 4 84 T 116 t 
 21 NAK 53 5 85 U 117 u 
 148
Nguyễn Gia Phúc, Nguyễn Thái Hà Giáo 
 trình Tin họcđạicương 
 22 SYN 54 6 86 V 118 v 
 23 ETB 55 7 87 W 119 w 
 24 CAN 56 8 88 X 120 x 
 25 EM 57 9 89 Y 121 y 
 26 SUB 58 : 90 Z 122 z 
 27 ESC 59 ; 91 [ 123 { 
 28 FS 60 < 92 \ 124 | 
 29 GS 61 = 93 ] 125 } 
 30 RS 62 > 94 ^ 126 ~ 
 31 US 63 ? 95 _ 127 DEL 
 149