kakashi Quản Trị
Tổng số bài gửi : 399 Xu : 5839 Join date : 31/08/2009 Age : 29 Đến từ : KONOHA Village
| Tiêu đề: Bài tập Pascal (tham khảo) của lớp 11A7 đêêêêêêê Sun Apr 10, 2011 1:40 pm | |
| 1/ Viết chương trình nhập mảng A, xuất A ra màn hình. Tìm UCLN & BCNN của mảng trên. - Code:
-
TYPE MANG= array [1..20] of word; VAR A: mang; b, k,i,u:word; {------------------------------------------} procedure nhap(var X:mang; n:byte); var i:byte; begin for i:=1 to n do begin write ('pt[',i,']='); readln(x[i]); end; end; {------------------------------------------} procedure xuat( x:mang; n:byte); begin for i:=1 to n do write(x[i]:5); writeln; end; {------------------------------------------} function uscln(a,b: word ): word; begin while a<>b do if a>b then a:=a-b else b:= b-a; uscln:=b; end; {------------------------------------------} function bscnn(m,n :word):word; var b:word; begin b:=m; while(b mod m <> 0) or (b mod n<> 0) do b:= b 1; bscnn:=b; end; {------------------------------------------} BEGIN write(' nhap so phan tu cua mang:'); readln(k); nhap(a,k); xuat (a,k); u:=a[1]; for i:=2 to k do u:=uscln(u,A[i]); writeln( 'uscln=',u); b:=a[1]; for i:=2 to k do b:= bscnn(b,A[i]); writeln('bscnn=',b); readln; end. 2/ Viết chương trình thực hiện các thao tác sau với 2 mảng A, B : Nhập 2 mảng A, B Xuất 2 mảng vừa nhập Sắp xếp 2 mảng trên Tìm UCLN & BCNN của từng mảng - Code:
-
USES CRT; TYPE Mang=array[1..20] of word; VAR A,B:Mang; n,m,i:byte; u,v:word; {--------------------------------------------------------} procedure NHAP(var A:Mang;n:byte); Var i:byte; Begin for i:=1 to n do begin write(' Nhap phan tu thu ',i,' cua mang : '); readln(A[i]); end; End; {--------------------------------------------------------} procedure XUAT(A:Mang;n:byte); var i:byte; Begin for i:=1 to n do write(A[i],' '); writeln; writeln; End; {------------------------------------------} function uscln(a,b: word ): word; begin while a<>b do if a>b then a:=a-b else b:= b-a; uscln:=b; end; {------------------------------------------} function bscnn(m,n :word):word; var b:word; begin b:=m; while(b mod m <> 0) or (b mod n<> 0) do b:= b 1; bscnn:=b; end; {--------------------------------------------------------} procedure SX(Var A:Mang;n:byte); var i,j:byte; t:word; begin for i:=1 to n-1 do for j:=i 1 to n do if A[i]>A[j] then begin t:=A[i]; A[i]:=A[j]; A[j]:=t; end; end; {--------------------------------------------------------} BEGIN clrscr; write('Nhap so phan tu cua mang A : '); readln(n); writeln('Nhap vao Mang A : '); NHAP(A,n); writeln; write('Nhap so phan tu cua mang B : '); readln(m); writeln('Nhap vao Mang B : '); NHAP(B,m); {In mang} writeln('Mang A : '); XUAT(A,n); writeln('Mang B : '); XUAT(B,m); {Sap xep} SX(A,n); SX(B,m); {UCLN} u:=a[1]; for i:=2 to n do u:=uscln(u,A[i]); writeln('UCLN of mang A = ',u); u:=b[1]; for i:=2 to m do u:=uscln(u,A[i]); writeln('UCLN of mang B = ',u);
{BCNN} v:=a[1]; for i:=2 to n do v:=bscnn(v,A[i]); writeln('BCNN of mang A = ',v); v:=b[1]; for i:=2 to m do v:=bscnn(v,A[i]); writeln('BCNN of mang B = ',v);
{Xem KQ} writeln('Mang A sau khi sap xep la : '); XUAT(A,n); writeln('Mang B sau khi sap xep la : '); XUAT(B,m); readln; END. 2/ Viết chương trình tính : S = S(a) S(b) (với S(n) = 1 2 3 . . . . n) T = T(a) T(b) (với T(n) = 1 * 2 * 3 * . . . . * n) - Code:
-
USES CRT; VAR a,b:word; S,T:integer; {------------------------------------------} procedure NHAP; begin writeln('Nhap 2 so nguyen duong a,b : '); readln(a,b); end; {------------------------------------------} function SUM(n:word):word; var i:integer; S:word; begin S:=0; SUM:=0; for i:=1 to n do S:=S i; SUM:=S; end; {------------------------------------------} function GT(n:byte):word; var i:byte; P:word; begin P:=1; GT:=1; for i:=1 to n do P:=P*i; GT:=P; end; {------------------------------------------} procedure RUN; begin NHAP; S:=SUM(a) SUM(b); T:=GT(a)-GT(b); writeln; writeln('S = ',S); writeln('T = ',T); readln; end; {------------------------------------------} BEGIN RUN END. 4/Viết chương trình nhập vào 2 xâu ST1 & ST2 rồi thực hiện các công việc sau : Xâu ST1 phải là con của xâu ST2 không ? Xâu ST2 phải là con của xâu ST1 không ? Xâu ST1 phải là con của xâu ST2 không ? - Code:
-
USES CRT; VAR ST1,ST2:string;
{-------------------------------------} procedure NHAP; begin Write('Nhap vao xau ST1 : '); readln(ST1); write('Nhap vao xau ST2 : '); readln(ST2); end; {-------------------------------------} function XauCon(s1,s2:string):boolean; begin if pos(s1,s2) <> 0 then XauCon:=TRUE else XauCon:=FALSE; end; {-------------------------------------} function DoiXung(s:string):boolean; var z:string; i:integer; begin z:=''; for i:=length(s) downto 1 do z:=z s[i]; if z=s then DoiXung:=TRUE else DoiXung:=FALSE; end; {-------------------------------------} BEGIN clrscr; NHAP; if XauCon(ST1,ST2) then writeln('ST1 la xau con cua ST2') else writeln('ST1 khong la xau con cua ST2');
if XauCon(ST2,ST1) then writeln('ST2 la xau con cua ST1') else writeln('ST2 khong la xau con cua ST1');
if DoiXung(ST1) then writeln('ST1 la xau doi xung') else writeln('ST1 khong la xau doi xung');
if DoiXung(ST2) then writeln('ST2 la xau doi xung') else writeln('ST2 khong la xau doi xung'); readln; END. 5/ Viết chương trình đọc từ Têp "KT.TXT" với cấu trúc : gồm nhiều dòng, nhiều cột. Hãy lập trình tính tổng từng dòng của Tệp "KT.TXT" rồi xuất kết quả đó ra Tệp "KQ.DAT". vd :* INPUT : KT.TXT | 1 2 3 4 5 3 2 4 7 8 1 1 0 5 6
| * OUTPUT : - Code:
-
USES CRT; CONST max=10; TYPE M1C = array[1..max] of integer; M2C = array[1..max,1..max] of integer; VAR A:M2C; K:M1C; n:integer; {----------------------------------------------} procedure DOCTEP; var fi:text; i,j:integer; begin assign(fi,'KT.TXT'); reset(fi); i:=1; j:=1; while not eof(fi) do begin while not eoln(fi) do begin read(fi,a[i,j]); inc(j); end; readln(fi); j:=1; inc(i); end; n:=i; end; {----------------------------------------------} procedure SUM; var i,j:integer; Begin for i:=1 to n do for j:=1 to max do K[i]:=K[i]+a[i,j]; end; {----------------------------------------------} procedure XUATTEP; var fo:text; i:integer; begin assign(fo,'KQ.DAT'); rewrite(fo); for i:=1 to n-1 do writeln(fo,K[i]); close(fo); end; {----------------------------------------------} BEGIN DOCTEP; SUM; XUATTEP; END. | |
|