bai tâp pascal

Bài tập Pascal A. BÀI TẬP VỀ CÂU LỆNH CÓ CẤU TRÚC Bài 1. Kiểm tra số nguyên tố Var n,I : integer; ok : boolean; Begin Vrite (‘nhập:’); Readln(n); If n <= 1 then ok:= False Else If n = 2 then ok:= True Else Begin I:= 2; While (n mod I <> 0) and ( i<= sqrt(n)); If i > sqrt(n) then ok:= true Else ok:= false; End; If ok then write (‘ Đó là số nguyên tố’) Else write (‘ Đó không à số nguyên tố’); Readln; End. Var n,I,k : integer; Begin Vrite (‘nhập:’); Readln(n); I:= 2; K:= trunc(sqrt(n)); Repeat Inc(i); Until (i>k) or (n mod I = 0) ; If i > k then then write (‘ Đó là số nguyên nguyên tố’) Else write (‘ Đó không à số nguyên tố’); Readln; End. Program Ktra_sngto; Var n: word; Funtion Ngto(k:word): Boolean; Var i,dem:Word; begin dem:=0; Ngto:=false; for i:=2 to n do if n mod i = 0 them dem:=dem+1; if dem = 2 then Ngto:= true; end; BEGIN Writeln('Nhap n '); readln(n); while n <2 do begin writeln('nhap lai'); readln(n); end; if Ngto(n) then writeln(' So nguyen to') else writeln('Khong la so nguyen to; End.

Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal Bài 2: Nhập 1 số tự nhiên n.Liệt kê các số nguyên tố nhỏ hơn n . VD: n=13 Các số nguyên tố nhỏ hơn n: 2 ,3 ,5 , 7, 11 Program bt; Var i,n,j : integer; Begin Write ('Nhap n:');Readln(n); Write ('Cac so nguyen to nho hon ',n,' la:'); For i:=2 to n-1 do Begin j:=2; While i mod j <>0 then j:=j+1; if i=j then write (i,','); end; readln; End.

Bài 3: Var n:longint; {------------------------------} Function ngto(n:longint):boolean; Var i:word; Begin ngto:=false; for i:=2 to trunc(sqrt(n)) do if n mod i=0 then exit; ngto:=true; end; {------------------------------} BEGIN write('nhap n: '); readln(n); for i:=2 to n do if ngto(i) then write(i,' '); Readln; END. Bài 4: tinh tổng và tích Var i,tong,tich,n,m:longint; Begin write('nhap so n,m: '); readln(n,m); tong:=0; tich:=1; for i:=1 to m do begin tong:=tong+(n mod 10); tich:=tich*(n mod 10); n:=n div 10; end; writeln('tong la: ',tong); writeln('tich la: ',tich); Readln; End.


Bài tập Pascal Bài 2: Nhập 1 số tự nhiên n.Liệt kê các số nguyên tố nhỏ hơn n . VD: n=13 Các số nguyên tố nhỏ hơn n: 2 ,3 ,5 , 7, 11 Program bt; Var i,n,j : integer; Begin Write ('Nhap n:');Readln(n); Write ('Cac so nguyen to nho hon ',n,' la:'); For i:=2 to n-1 do Begin j:=2; While i mod j <>0 then j:=j+1; if i=j then write (i,','); end; readln; End.

Bài 3: Var n:longint; {------------------------------} Function ngto(n:longint):boolean; Var i:word; Begin ngto:=false; for i:=2 to trunc(sqrt(n)) do if n mod i=0 then exit; ngto:=true; end; {------------------------------} BEGIN write('nhap n: '); readln(n); for i:=2 to n do if ngto(i) then write(i,' '); Readln; END. Bài 4: tinh tổng và tích Var i,tong,tich,n,m:longint; Begin write('nhap so n,m: '); readln(n,m); tong:=0; tich:=1; for i:=1 to m do begin tong:=tong+(n mod 10); tich:=tich*(n mod 10); n:=n div 10; end; writeln('tong la: ',tong); writeln('tich la: ',tich); Readln; End.


Bài tập Pascal Bài 5 : Nhập 1 số đếm các chứ số của số nhập vào. Var a,i,j,n:longint; Begin write('Nhap so n: ');readln(n); i:=0; j:=10; repeat a:=n mod j; j:=j*10; i:=i+1; until a=n; write('So chu so cua n la: ',i); readln; End Bài 6. Đổi kí tự t ự thành chữ hoa Program DoiChu; Var St:String; i: integer; Begin Write('Hãy nhập tên của bạn : '); Readln(St); FOR i:= 1 TO Length(St) DO St[i] := Upcase(St[i]); (*Hàm Upcase đổi ký tự thành chữ in hoa*) Writeln; Writeln(St); Readln; End. Bài 7 : VCT tính t ính số tiền điện trong 1 thắng. Var kw, SoTien:LongInt; Begin Write('Nhap so KW dien da su dung trong thang: '); Readln(kw); Case kw of 1..100: SoTien := kw*650; 101..200: SoTien :=100*650+(kw-100)*1100; :=100*650+(kw-100)*1100; 201..300: SoTien :=100*650+100*1100+(kw-200)*2000; :=100*650+100*1100+(kw-200)*2000; :=100*650+100*1100+100*2000+(kw-300)*3000; 0)*3000; Else SoTien :=100*650+100*1100+100*2000+(kw-30 End; Writeln('So Tien phai tra trong thang la: ',SoTien); Readln; End Bài 8 :Viết chương trình kiểm tra t ra trong 3 số a,b,c nhập từ bàn phím số nào là lớn nhất. uses crt; var a, b, c, max: integer; Begin clrscr; write ('Nhap so a:= '); readln (a); write ('Nhap so b:= '); readln (b); write ('Nhap so c:= '); readln (c); max:=a; {cái này dạng như chúng ta giả sử a là số lớn nhất :D } if max
Bài tập Pascal Bài 12: Nhập vào một số, máy sẻ báo: chẳng hay hay lẻ, chính phương hay ko? Var a: integer; Begin Write(‘nhap a:’); readln(a); If a mod 2 = 0 then writeln(a,’la so chan’) Else Writeln(a,’la so le’); If sqrt(a) = int(sqrt(a)) then writeln(a,’la so chinh phuong’) Else writeln(a,’khong la so chinh phuong’); readln; End. Bài 13: Tính 1 – 2 2 + 32 – 42 + … +n2 Var Write(‘nhap n’); readln(n); S:= 0; For i:= 1 to n do If I mod 2 <> 0 then S:= S + sqr(i) Else S:= S – sqr(i); Writeln(‘tong la :=’,S); Readln; End. Bài 14: Chuyển số thập phân thành dãy số nhị phân. Var n, m, I : integer; chuso : byte; {chữ số chỉ nhận 2 giá trị: tr ị: 0, 1} Begin Write(‘nhập n =’); readln(n); m := 16384 = 2 14 ; write(0); {chu so dau tien la 0} for i := 1 to n do begin chuso := n div m ; {chu so nhi phan dau tien} write(chuso); if (i+1) mod 4 = 0 then write (‘ ‘); n := n – m*chuso; m :=mdiv 2; end; readln; End. Bài 15: Nhập 1 số nguyên dương in ra màn hình UCLN Var n, m, I : integer; Begin Write(‘nhap n:’); readln(n); m := 0; for i := 1 to n do Begin m := n div I; if (m mod 2 <> 0) and (m > max) them max := m; end; writeln(‘UCLN;,max); readln; End. Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal Bài 16: Tính lãi suất 15% tháng Const LS = 0,015 Var X, Y, XX : real; Begin Write(‘nhap X, Y: ‘); readln(X,Y); XX := X; Month := 0; Repeat Month := month + 1; XY := XX+ XX*LS; Until XY = Y; Writeln(‘ Tong so tien lai :’,Y – X); Writeln(‘so thang gui:’,month); Readln; End. Bài 17: VCT xác định số ngày của 1 tháng N. Var M: 1990 ..2010; N: 1..12; Begin Write(‘nhap nam hien tai:’); readln(M); Write(‘nhap thang hien tai:’); readln(N); Case N of 1,3,5,7,8,10,12: writeln(‘co 31 ngay’); 4,6,9,11 : writeln(‘co 30 ngay’); 2 : writeln(cos 29 ngay’) Else Writeln(‘co 28 ngay’); Readln; End. Bài 18. Lập trình tìm các số có ba chữ số với điều kiện giá trị của số đó bằng tổng lập phương các chữ số của nó. uses crt; Var a,b,c,i:integer; Begin clrscr; For i:=100 to 999 do begin a:=i div 100; b:=(i div 10) mod 10; c:=i mod 10; if a*a*a+b*b*b+c*c*c=i then begin Writeln('So ',i,' co gia tri bang tong lap phuong cac chu so cua no.'); end; end; Readln; End.

Bài 19. Tính tổng sau (với x thực nhập từ bàn phím): Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal Chương trình dừng khi

n

( −1) .

x

2n + 1

(2n

1)

0,0001

<

+

uses crt; Var i:integer; a,b,c,x,t:real; Procedure tinh; begin a:=x;b:=0;t:=x;c:=1; While abs(c*a/(2*b+1))>=0.0001 do begin a:=a*x;b:=b+1;c:=c*-1; t:=t+c*a/(2*b+1); end; end; Begin clrscr; Write('Ban hay nhap so x:');Readln(x); tinh; Writeln('Ket qua la:',t:0:10); Readln; End. Bài 20: Nhập vào một số tự nhiên n.Lập trình trả lời các câu hỏisau: - n có bao nhiêu chữ số? - Tổng các chữ số của n bằng bao nhiêu? - Tìm chữ số đầu tiên của n. - Giả sử trong cách biểu diễn thập phân của n có dạng sau: akak - 1 .....a 2 a 1 a 0 . Hãy tính tổng S = ak - ak - 1 + ak - 2 - .... + (-1) k + 1 .a 0 - Nhập vào số m (m ≤ số chữ số của n). Hãy tính tổng m chữ số cuối cùng của n. uses crt; var i,k,m,n:longint; s:string; Begin clrscr; Repeat Write('Ban hay nhap so thu nhien n:');Readln(n); if n<0 then Writeln('n phai la so tu nhien.'); Until n>=0; Str(n,s); Writeln('So ',n,' co ',length(s),' chu so.'); k:=0;m:=0; For i:=1 to length(s) do begin k:=k+(ord(s[i])-48); if i mod 2=1 then m:=m+(ord(s[i])-48) else m:=m-(ord(s[i])-48); end; Writeln('Tong cac chu so cua ',n,' la:',k,'.'); Writeln('Chu so dau tien cua ',n,' la:',s[1],'.'); Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal Writeln('Tong S la:',m); Repeat Write('Ban hay nhap so m(m<=so chu so cua n):'); Readln(m); if m>length(s) then Writeln('m phai <=',length(s), '.' ); Until m<=length(s); Delete(s,1,length(s)-m); k:=0; For i:=1 to length(s) do k:=k+(ord(s[i])-48); Writeln('Tong ',m,' chu so cuoi cung cua ',n,' la:',k,'.'); Readln; End.

Bài 21.Với giá trị x nhập từ bàn phím, hãy tính tổng sau: ( x −1) ( x +1)

+

cho đến khi

( x −1) 3 3. ( x +1) 3

+

( x

1) 5

−

5. ( x

+

1) 5

...

+

+

( x −1) 2

( x −1) 2 ( 2n +1) . ( x

1

n+

(2n +1) . ( x +1) 2

1

n+

<

0,0001

uses crt; var i:integer; a,b,x,t: real; Procedure tinh; begin i:=1; a:=x-1;b:=x+1;t:=a/(i*b); While a/(i*b)>=0.0001 do begin i:=i+2; a:=a*(x-1)*(x-1); b:=b*(x+1)*(x+1); t:=t+a/(i*b); end; end; Begin clrscr; Write('Ban hay nhap so x:');Readln(x); if x<>-1 then begin if x=1 then Writeln('Ket qua la:0') else begin tinh; Writeln('Ket qua la:',t:0:10); end; end else Writeln('Cac phan tu co mau la 0 nen the chia duoc.'); Readln; End.


1

n+

1) 2

+

1

n+

+

...

Bài tập Pascal Bài 22.Lập trình tính tổng các số nguyên. uses crt; var n,i:integer; tong:real; t:char; Begin repeat clrscr; writeln(' CHUONG TRINH TINH TONG N SO'); writeln('S = 1 + 1/2 + 1/3 +...+ 1/n'); writeln; write('Nhap so gioi han can tinh, n=');readln(n); tong:=1; for i:=2 to n do tong:=tong+1/i; writeln('Ket qua, S =',tong:7:4); writeln; writeln('An Phim BAT KY de TIEP TUC, X de THOAT!...'); t:=readkey; until (t='x') or(t='X'); End. Bài 23.Lập trình đưa ra màn hình các số nguyên tố từ 1 đến 100. uses crt; var i,k:integer; Function snt(var a:integer):integer; var i,d:integer; begin d:=0; for i:=2 to round(sqrt(a)) do if (a mod i)=0 then d:=d+1; if d=0 then snt:=1 else snt:=0; end; Begin clrscr; writeln('CHUONG TRINH IN CAC SO NGUYEN TO TU 1 DEN 100'); writeln; k:=0; for i:=1 to 100 do if snt(i)<>0 then begin write(i:5); k:=k+1; if k=13 then begin writeln; k:=0; end; end; writeln; writeln('An Phim Bat ky de THOAT!...'); repeat until keypressed; end.


Bài tập Pascal Bài 24.Tính biểu thức sau với x là số thực cho trước (x 0), yêu cầu kiểm tra điều kiện x nhập vào từ bàn phím: uses crt; var i:integer; x:real; Function tinh(i:integer):real; var r: real; begin if i<256 then r:=x*x+i/tinh(i*2) else r:=x*x+i/(x*x); tinh:=r; end; Begin clrscr; Repeat Write('Ban hay nhap so thuc x:');Readln(x); if x=0 then Writeln('Ban phai nhap x khac 0.'); Until x<>0; Write('Ket qua la:',tinh(2):0:2); Readln; End. Bài 25. Số hoàn hảo Nhập từ bàn phím một số tự nhiên N. Lập chương trình tìm tất cả các số hoàn hảo có giá trị từ 1 đến N (nếu có). Nếu không có hãy đưa ra thông báo “Không có”. (Số hoàn hảo là một số tự nhiên thoả mãn điều kiện: giá trị số đó bằng tổng các ước số thực sự của nó mà không kể chính số đó). uses crt; var i,k,m,n,s:integer; Begin clrscr; Repeat Write('Ban hay nhap so n:');Readln(n); Until n>=0; For i:=2 to n do if i mod 2=0 then begin m:=1; For k:=2 to i-1 do if i mod k=0 then m:=m+k; if m=i then begin s:=s+1; Writeln(i); end; end; Writeln('Co ',s,' so hoan hao co gia tri tu 1 den ',n,'.'); Readln; End.


Bài tập Pascal Bài 26: Tính số ngày giữa 2 mốc thời gian bất kỳ: Yêu cầu nhập vào 6 số: nd , td , yd , nc , tc , yc là ngày tháng năm bắt đầu và ngày tháng năm cuối ( 2000 < yd < yc ). Hãy tính xem giữa hai mốc thời gian đó có bao nhiêu ngày. Biết rằng: Tháng 4, 6, 9, 11 có 30 ngày.Tháng 1, 3, 5, 7, 8, 10, 12 có 31 ngày.Tháng 2 nếu năm nhuận có 29 ngày còn nếu không nhuận thì có 28 ngày. Bốn năm có một năm nhuận, biết rằng năm 2000 thì năm nhuận. uses crt; var i, k, m, n, nd, td, yd, nc, tc,yc : integer; Function ng(t,n:integer):integer; Var a:integer; begin Case t of 4,6,9,11:a:=30; 1,3,5,7,8,10,12:a:=31; 2:if n mod 4<>0 then a:=28 else a:=29; end; ng:=a; end; Begin clrscr; Writeln('Ban hay nhap ngay thang nam bat dau:'); Write('Ngay:');Readln(nd); Write('Thang:');Readln(td); Write('Nam:');Readln(yd); Writeln('Ban hay nhap ngay thang nam cuoi:'); Write('Ngay:');Readln(nc); Write('Thang:');Readln(tc); Write('Nam:');Readln(yc); n:=0; if yd<>yc then begin For i:=yd+1 to yc-1 do if i mod 4<>0 then n:=n+365 else n:=n+366; For i:=td to 12 do n:=n+ng(i,yd); n:=n-nd; For i:=1 to tc-1 do n:=n+ng(i,yc); n:=n+nc; end; Writeln('Giua hai moc thoi gian do co ',n,' ngay.'); Readln; End. Bài 27: Trên một bàn cờ có n x n ô, hãy lập trình xếp 2n quân cờ lên bàn cờ sao cho không có quá 2 quân cờ trên 1 hàng và trên 1 cột. Chỉ cần in ra một cách xếp lên màn hình (dùng dấu ‘*’làm ký hiệu quân cờ ). var i,k,n:integer; Begin clrscr; Write('Ban hay nhap so n:');Readln(n); For k:=1 to n do begin For i:=1 to n do if (i in [k,k+1]) or ((k=n) and (i=1)) then Write('*') else Write('-'); Writeln; end; Readln; End. Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal B. BÀI TẬP VỀ MẢNG Bài 1: Cho mãng gồm n phần tử là số thực. a.Tìm hai phần tử liên tiếp nhau có tổng bằng n. b. Tính khoảng cáhc giữa hai vị trí của phần tửlớn nhất và bé nhất đầu tiên trên A. Var A: array[1..100] of real; Max, min : real; I, n, Vtmax, Vtmin : integer; Begin Writeln(‘nhap n:’); readln(n); For i:= 1 to n do Begin Write(‘[‘,I,’]=’); readln(A[i]); End; i:=1; {Tìm hai phần tử liên tiếp nhau có tổng bằng n} While (A[i] + A[i+1]) <> n) and (i<= n-1) do Inc(i); If i>=n then write (‘hai phan tu co chi so la:’,i,’ va’,i+1); {Tính khoảng cáhc giữa hai vị trí của phần tử lớn nhất và bé nhất đầu tiên trên A } Max:=A[1]; Min:=A[1]; For i:=1 to n do If max < A[i] then Begin Vtmax:= i; Max:=A[i]; End; If min > A[i] then Begin Vtmin:= i; Min:=A[i]; End; Writeln (‘khoangr cachs giua 2 phan tu max vaf min la:’,abc(Vtmax – Vtmin); Readln; End. Bai 2: const NMax = 50; Type Mass = array[1...NMax, 0...NMax-1] of real; Var A: Mass; i, j, N:byte; C: real; Begin write ('Nhap N='); readln(N); for i:= 1 to N do for j:= 0 to N-1 do begin write('A[',i,',',j,']= '); readln(A[i,j]); end; for i:= 1 to N do for j:= 0 to N-1 do begin C:= A[i,j]; A[i,j]:= A[N-i+1,j]; A[N-j+1,j]:= C; end; for i:= 1 to N do begin for j:= 0 to N-1 do write (A[i,j]:5:2,' '); writeln; end; End. Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal Bài 3 :nhập vào chương trình vào 1 mảng số nguyên, sau đó liệt kê các số dương trong mảng rồi in ra màn hình Program bt; Var a:array [1..1000] of longint; i,n:word; Begin write('nhap so phan tu cua mang: '); readln(n); for i:=1 to n do begin write('nhap phan tu a[',i,']: '); readln(a[i]); end; write('cac phan tu duong la: '); for i:=1 to n do if a[i]>0 then write(a[i],' '); readln; End. Bài 5: Sắp xếp một dãy số theo thứ tự từ nhỏ đến lớn Tiến trình của bài toán: - Giả sử chuỗi số của ta có n phần tử . Lần lượt cho chương trình đọc giá trị của các phần tử nhập được. - Một thủ tục (Procedure) sẽ làm công việc sắp xếp như sau : đầu tiên đưa phần tử thứ nhất so sánh với các phần tử tiếp theo, nếu nó lớn hơn phần tử so sánh thì đem đổi chổ giá trị của hai phần tử với nhau. Sau đó tiếp tục đem phần tử thứ 2 so sánh các phần tử tiếp theo theo trình tự như vậy, ... và cứ như thế cho đến phần tử thứ n - 1. - In kết quả ra màn hình Chương trình Pascal như sau: (* Sắp xếp một mảng các phần tử số thực từ nhỏ đến lớn*) VAR n, i, loc: 1 .. 100 ; x : ARRAY [1 .. 100] OF real ; temp : real ; PROCEDURE interchange ; (* Ðổi chỗ các phần tử mảng từ nhỏ đến lớn*) BEGIN FOR loc := 1 TO n-1 DO FOR i := loc + 1 TO n DO IF x[i] < x [loc] THEN BEGIN temp := x[loc] ; x[loc] := x[i] ; x[i] := temp ; END ; END ; BEGIN Write (' Có bao nhiêu phần tử số ? ') ; Readln (n) ; FOR i := 1 TO n DO BEGIN Write ( ‘ x[ ‘, i : 3, ‘] = ? ‘ ) ; Readln( x[i] ) ; END ; interchange ; Writeln ; Writeln (' Số liệu đã sắp xếp : ') ; Writeln ; FOR i := 1 TO n DO Writeln ( ‘x[ ‘, i : 3, ‘ ] = ‘, x[i] : 4 : 1 ) ; Readln; END. Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal Bài 4: viết chương trình nhập vào 1 mảng 2 chiều, gồm các số nguyên, sau đó xuất ra màn hình các số lẻ Program bai2; var a:array [1..10,1..10] of longint; i,j,m,n:byte; Sh, tbphc, L : integer; Tccl : real; {khai bao du lieu} Begin write('nhap m,n: '); readln(m,n); for i:=1 to m do for j:=1 to n do begin write('nhap phan tu a[',i,',',j,']: '); readln(a[i,j]); end; for i:=1 to m do for j:=1 to n do if odd(a[i,j]) then write(a[i,j],' '); {tong so hang le } Sh := 0; For i := 1 to n do For j := 1 to n do Sh := sh + A[I,j]; Write(‘tong so hang’,sh); {tong binh phuong cac so tren hang chan } Tbphc := 0; For i := 1 to n div 2 do For j := 1 to n do Tbphc := tbphc + sqr (A[I sh1 1,j]); Writeln(‘tong binh phuong cac so hang chan’,tbphc); {tinh tong can bac 2 cac cot le } Tccl := 0; For := 1 to n do For j :=1 to n div 2 do Tccl : =tccl + sqrt(A[I,j sh 1 2] – 1); Writeln(tong can cot le’,tccl); {co bao nhieu gia tri nam trongg 4 ..6 } L : = 0; For := 1 to n do For j :=1 to n div 2 do If (A[I,j] > = 4) and (A[I,j] <= 6) then Inc(L); Writeln(so phan tu nam trong khoang 4 ..6 la’,L); {tong duong cheo chinh } Dcc := 0; For i:=1 to m do For j:=1 to n do Begin If i=j then Dcc:=dcc + A[I,j]; End; Writeln(‘tong duong cheo chinh’,dcc); Readln; End.


Bài tập Pascal Bài 5: program BT; const NMax = 50; type Mass = array[1...NMax, 0...NMax-1] of real; var A: Mass; i, j, N:byte; C: real; Begin write ('Nhap N=');readln(N); for i:= 1 to N do for j:= 0 to N-1 do begin write('A[',i,',',j,']= '); readln(A[i,j]); end; {Đoạn trên này để nhập vào 1 ma trận} for i:= 1 to N do for j:= 0 to N-1 do begin C:= A[i,j]; A[i,j]:= A[N-i+1,j]; A[N-j+1,j]:= C; end; {Đoạn này để đổi vị trí các hàng của ma trận theo kiểu hàng đầu đổi cho hàng cuối, hàng thứ 2 đổi cho hàng kế cuối } for i:= 1 to N do begin for j:= 0 to N-1 do write (A[i,j]:5:2,' '); writeln; end; {Còn đoạn cuối này thì để in ma trận đã được đổi vị trí các hàng ra màn hình} readln; end. Bài 6: VCT đổi 1 số nguyên hệ 10 sang hệ 2. Var NP: array[1.. 16] of byte; n, i, j : integer; Begin Write(‘nhao n:’); readln(n); For i := 1 to 16 do NP[i] := 0; i := 1; while n <>0 do begin NP[i] = n mod 2; n := n div 2; end; for j := I downto 1 do write (NP[j]; readln; End.


Bài tập Pascal Bài 7: Var A: array[1..100] of real; I, j : byte; temp : real; Begin Writeln(‘nhap so phan tu cho mang::’); readln(n); For i:= 1 to n do Begin Write(‘[‘,i,’]=’); readln(A[i]); End; {sap xep tang dan} For i := 1 to n do For j := i + 1 to n do If A[i] > a[j] then Begin Temp := A[i]; A[i] := A[j]; A[i] := temp; End; Writeln(‘mang do sap xep xong’); For i := 1 to n do write (A[i]:5:3); {chen M vao day} Write(‘nhap gia tri M:’); readln(M); If M >= A[i] then A[i+1] := M Else Begin J :=1; While M> A[j] do J := j + 1; For i := n+1 downto j – 1 do A[i] := A[i-1]; A[j] := M; End; Writeln(‘ket qua sau khi chen:’); For j :=1 to n +1 do Write(A[j] : 6); Readln; End. Bài 8: Var X: array [1..50] of integer; I,n, max : integer; s : real; Begin Write(‘nhap so phan tu:’); readln(n); S:=0; For i:= 1 to n do Begin Write(‘nhap mang X[‘,1,’]=’); readln(X[i]); End; { tinh tong binh phuong cac so am trong day } If A[i] < 0 then S:= S + sqr(X[i]); Writeln(‘tong la:’,S:5); { Tim so lon nhat } Max := 1; if X[i] . max then max := X[i]; writeln(‘so lon nhat la:’, max);


Bài tập Pascal { tim phan tu dau tien chia het cho 10 } Ok:= false; I := 1; While (not ok) and (I <=n) do If X[i] mod 10 = 0 then ok := true Else I:= i+1; If ok then write(‘so thu’,I,’ la:’,X[i]) Else Write(‘khong tim thay’); Readln; End. Bài 9:Cho dãy số thực bất kỳ, hãy kiểm tra xem dãy số đã sắp xếp chưa? Nếu sắp xếp rồi thì theo chiều nào? Nếu chưa thì sắp xếp theo chiều tăng dần. uses crt; Var a:array [1..1000] of real; i,k,n:integer; m:real; Begin clrscr; Write('Ban hay nhap so phan tu cua day:');Readln(n); For i:=1 to n do begin Write('Ban hay nhap so thu ',i,':');Readln(a[i]); if (i>1) and (k<>3) then begin if (a[i]>a[i-1]) and (k<>1) then if k=0 then k:=1 else k:=3; if (a[i]2) then if k=0 then k:=2 else k:=3; end; end; Case k of 1:Writeln('Day duoc sap xep theo thu tu tang dan.'); 2:Writeln('Day duoc sap xep theo thu tu giam dan.'); 3:begin Writeln('Day chua duoc sap xep.'); Writeln('Sap xep lai theo thu tu tang dan:'); For k:=1 to n-1 do For i:=1 to n do if a[k]

Bài tập Pascal Bài 10: Nhập vào một dãy các số nguyên bất kỳ, in ra màn hình các số khác nhau trong dãy số đó. uses crt; var a:array [1..1000] of longint; i,k,m,n:longint; Begin clrscr; Repeat Write('Ban hay nhap so phan tu cua day:');Readln(n); if n<=0 then Write('Ban phai nhap so>0.'); Until n>0; For i:=1 to n do begin Write('Ban hay nhap so thu ',i,':');Readln(a[i]); end; Writeln('Cac so khac nhau trong day la:'); For i:=1 to n do begin m:=0; For k:=1 to i-1 do if a[i]=a[k] then begin m:=1;break;end; if m=0 then Write(a[i],' '); end; Readln; End. Bài 11.Viết chương trình nhập vào một ma trận vuông k hàng, k cột. Sau đó sắp xếp lại sao cho phần tử có trị tuyệt đối lớn nhất trong mỗi hàng sẽ nằm trên đường chéo chính. uses crt; var a:array [1..100,1..100] of integer; i,k,m,n:longint; Begin Repeat Write('Ban hay nhap so k(hang,cot:');Readln(n); if n<=0 then Write('Ban phai nhap so>0.'); Until n>0; For k:=1 to n do For i:=1 to n do Begin Write(‘nhap a[',i,',',k,']:'); Readln(a[i,k]); end; For k:=1 to n do begin m:=1; For i:=2 to n do if abs(a[m,k])
Bài tập Pascal Bài 12. Viết chương trình nhập vào một dãy n số nguyên và in ra màn hình các thông tin sau (Nếu không có số nào thoả mãn thì đưa ra thông báo không có): - Số hạng âm lớn nhất của dãy và chỉ số của nó; - Số hạng dương nhỏ nhất của dãy và chỉ số của nó; - Số lượng số hạng dương liên tiếp nhiều nhất; - Số lượng số hạng âm liên tiếp có tổng lớn nhất; - Số lượng số hạng liên tiếp đan dấu nhiều nhất. uses crt; Var a:array [1..1000] of longint; kq:array [1..5] of integer; i,k,n,d1,d2,d3:integer; Begin clrscr; Repeat Write('Ban hay nhap so phan tu cua day:');Readln(n); if n<=0 then Writeln('Ban phai nhap so lon hon 0.'); Until n>0; For i:=1 to n do begin Write('Ban hay nhap so thu ',i,':');Readln(a[i]); if ((a[i]>a[kq[1]]) or (kq[1]=0)) and (a[i]<0) then kq[1]:=i; if ((a[i]0) then kq[2]:=i; if (a[i]>0) and (a[i-1]>0) and (i>1) then begin if d1=0 then d1:=2 else d1:=d1+1; end else begin if kq[3]1) then begin if d2=0 then d2:=2 else d2:=d2+1;end else begin if kq[4]1) then begin if d3=0 then d3:=2 else d3:=d3+1;end else begin if kq[5]0 then Writeln('So hang am lon nhat la so thu ',kq[1],':',a[kq[1]],'.') else Writeln('Khong co so am nao trong day.'); if kq[2]<>0 then Writeln('So hang duong nho nhat la so thu ',kq[2],':',a[kq[2]],'.') else Writeln('Khong co so duong nao trong day.'); if kq[3]<>0 then Writeln('So luong cac so duong lien tiep lon nhat la:',kq[3],'.') else Writeln('Khong co cac so duong nao lien tiep trong day.'); if kq[4]<>0 then Writeln('So luong cac so am lien tiep lon nhat la:',kq[4],'.') else Writeln('Khong co cac so am nao lien tiep trong day.'); if kq[5]<>0 then Writeln('So luong cac so dan dau lien tiep lon nhat la:',kq[5],'.') else Writeln('Khong co cac so dan dau nhau nao lien tiep trong day.'); Readln; End. Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal Bài 13.Điền các số từ 1 đến nxn theo chiều kim đồng hồ vào mảng hai chiều. In mảng kết quả ra màn hình theo dạng n dòng và n cột. uses crt; var a:array [1..100,1..100] of integer; i,k,m,n,c1,c2,c3,c4:integer; Begin clrscr; Repeat Write('Ban hay nhap so n:');Readln(n); if n<=0 then Writeln('Ban phai nhap so lon hon 0.'); Until n>0; clrscr; m:=0; c1:=1;c2:=1;c3:=n;c4:=n; Repeat For i:=c1 to c3 do begin m:=m+1; a[i,c2]:=m; Gotoxy(i*3,c2);Write(a[i,c2]); end; c2:=c2+1; For i:=c2 to c4 do begin m:=m+1; a[c3,i]:=m; Gotoxy(c3*3,i);Write(a[c3,i]); end; c3:=c3-1; For i:=c3 downto c1 do begin m:=m+1; a[i,c4]:=m; Gotoxy(i*3,c4);Write(a[i,c4]); end; c4:=c4-1; For i:=c4 downto c2 do begin m:=m+1; a[c1,i]:=m; Gotoxy(c1*3,i);Write(a[c1,i]); end; c1:=c1+1; Until m>=n*n; Readln; End.


Bài tập Pascal Bài 14.Lập trình đưa ra màn hình bảng cửu chương có dạng: 1 2 3 ... 9 2 18 . . 9 18 ... 81 bằng hai cách. uses crt; type m = array [1..20,1..20] of integer; var a,b:m; h,c:integer; procedure in1(var b:m;u:integer;v:integer); var i,j:integer; tg:integer; begin for j:=1 to v do b[1,j]:=j; for i:=1 to u do b[i,1]:=i; for i:=2 to u do for j:=2 to v do begin tg:=i*b[1,j]; b[i,j]:=tg; end; end; procedure in2(var b:m;u:integer;v:integer); var i,j:integer; begin for j:=1 to v do b[1,j]:=j; for i:=1 to u do b[i,1]:=i; for j:=2 to v do for i:=2 to u do b[i,j]:=b[i-1,j]+j; end; procedure hienthi(var b:m;u:integer;v:integer); var i,j:integer; begin for i:=1 to u do begin for j:=1 to v do writeln; end; end; Begin clrscr; h:=9; c:=9; writeln(' IN BANG CUU CHUONG'); in1(a,h,c); writeln('Cach 1:'); hienthi(a,h,c); writeln; writeln('Cach 2:'); in2(a,h,c); hienthi(a,h,c); writeln; write('An Phim Bat ky de THOAT!...'); repeat until keypressed; End. Sưu tầm và biên soạn: Nguyễn Minh Đức

write(b[i,j]:5)

Bài tập Pascal Bài 15: Nhập vào hai số tự nhiên n và m. Hãy in ra chu kỳ của phân số n/m Ví dụ: 1/7 có chu kỳ là (142857). Còn các phân số hữu hạn thì chu kỳ bằng 0. uses crt; var a:array [1..1000,1..2] of longint; i,k,m,n,t,p:longint; ck:string; Function ucln(m,n:longint):longint; begin While m<>n do begin if mn then m:=m-n; end; ucln:=m; end; Procedure tinh(m,n:longint); begin While n>m do n:=n-m; k:=ucln(m,n);n:=n div k;m:=m div k; i:=0;t:=0; n:=n*10; Repeat i:=i+1; a[i,1]:=n div m; a[i,2]:=n; if n mod m=0 then t:=2; n:=(n mod m)*10; For k:=1 to i-1 do if (a[k,1]=a[i,1]) and (a[k,2]=a[i,2]) then begin p:=k;t:=1;Break; end; Until (t<>0) or (i>1000); if t=1 then For k:=t to i-1 do ck:=ck+chr(a[k,1]+48) else ck:='0'; end; Begin clrscr; Repeat Write('Ban hay nhap so tu nhien n:');Readln(n); Write('Ban hay nhap so tu nhien m:');Readln(m); if n*m<0 then Writeln('Ban phai nhap 2 so tu nhien.'); if m=0 then Writeln('m phai khac 0.'); Until (n*m>=0) and (m<>0); if n mod m=0 then ck:='0' else tinh(m,n); Writeln(n,'/',m,' co chu ky = ',ck); Readln; End.


Bài tập Pascal Bài 16: Cho số tự nhiên n và dãy các số thực a 1 , a2 , .....an, trong đó hãy xác định số lượng các phần tử kề nhau mà: a. Cả hai số đều dương. b. Cả hai số đều cùng dấu đồng thời số đứng trước có giá trị tuyệt đối lớn hơn số đứng sau. c. Cả hai số trái dấu nhau. uses crt; var a:array [1..1000] of longint; kq:array [1..3] of integer; i,n:integer; Begin clrscr; Repeat Write('Ban hay nhap so phan tu cua day:'); Readln(n); if n<=0 then Writeln('Ban phai nhap so lon hon 0.'); Until n>0; For i:=1 to n do begin Write('Ban hay nhap so thu ',i,':');Readln(a[i]); if i>1 then begin if (a[i]>0) and (a[i-1]>0) then kq[1]:=kq[1]+1; if (a[i]*a[i-1]>=0) and (abs(a[i-1])>abs(a[i])) then kq[2]:=kq[2]+1; if a[i]*a[i-1]<0 then kq[3]:=kq[3]+1; end; end; Writeln('Co ',kq[1],' cap phan tu ke nhau ma ca hai so deu duong.'); Writeln('Co ',kq[2],' cap phan tu ke nhau ma ca hai so cung dau va so dung truoc co gia tri tuyet doi lon hon so dung sau.'); Writeln('Co ',kq[3],' cap phan tu ke nhau ma ca hai so trai dau nhau.'); Readln; End. Bài 17:Tam giác Pascal Hãy in ra màn hình tam giác Pascal có n dòng và tính xem ở hàng thứ i có bao nhiêu số j (với n, i, j nhập từ bàn phím). uses crt; var a:array [1..100,1..100] of longint; i,j,k,m,n,p:longint; c:char; Procedure nhap(w:string;var a:longint); Var k:integer; s:string; begin Repeat Write(w);Readln(s); Val(s,a,k); Until k=0; end; Begin Repeat clrscr; Repeat Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal k:=0; nhap('Ban hay nhap so n:',n); if n<=0 then k:=1; if n>80 then begin Write('Ban co chac chan muon nhap so n lon nay khong?(c/k)'); Repeat c:=Readkey; Until Upcase(c) in ['C','K']; if Upcase(c)='K' then k:=1; Writeln; end; Until k=0; clrscr; Writeln('n=',n); For i:=1 to n do a[1,i]:=1; Gotoxy(40,2);Write('1'); For k:=2 to n do For i:=1 to k do begin if i>1 then a[i,k]:=a[i-1,k-1]+a[i,k-1]; Gotoxy(37-k*6 div 2+i*6,k+1);Write(a[i,k]); end; Writeln; if i>14 then begin Textcolor(4); Writeln('Ban nhap so n hoi lon so voi be rong man hinh cho phep.'); Textcolor(7); end else Writeln; Repeat Repeat nhap('Ban hay nhap so i(hang i):',i); if (i>n) or (i<1) then Writeln('So i phai nam trong khoang tu 1->n(0

Bài tập Pascal Bài 18. Bài toán số nguyên tố tương đương Hai số tự nhiên được gọi là nguyên tố tương đương nếu chúng có chung các ước số nguyên tố. Ví dụ như các số 75 và 15 là nguyên tố tương đương vì cùng có các ước nguyên tố là 3 và 5. Cho trước hai số tự nhiên M và N. Hãy viết chương trình kiểm tra xem các số này có là nguyên tố tương đương với nhau không? uses crt; var a:array [1..100] of integer; i,k,m,n:integer; Begin clrscr; Write('Ban hay nhap so thu nhat:');Readln(m); Write('Ban hay nhap so thu hai:');Readln(n); if m=n; if k=0 then Writeln('Hai so tren khong phai la hai so nguyen to tuong duong voi nhau.'); Readln; End. Bài 19. Số siêu nguyên tố Số siêu nguyên tố là số nguyên tố mà khi bó đi một số tuỳ ý các chữ số bên phải của nó thì phần còn lại vẫn tạo thành một số nguyên tố. Ví dụ: 7333 là số siêu nguyên tố có 4 chữ số vì 733; 73; 7 đều là các số nguyên tố. Hãy lập chương trình nhập dữ liệu vào là một số nguyên N ( 0 < N < 10 ) và đưa ra kết quả là các số siêu nguyên tố có N chữ số cùng số lượng của chúng. uses crt; const d:array [1..6] of char=('1','2','3','5','7','9'); var i,k,m,n:integer; s:string; c:char; Function kt(s:string):boolean; var k:integer; a,i:real; b:boolean; begin Val(s,a,k); b:=True; i:=1;


Bài tập Pascal While i<=sqrt(a) do begin i:=i+1; if a/i=round(a/i) then begin b:=False; Break; end; end; kt:=b; end; Procedure tim(i:integer); var k:integer; begin For k:=1 to 6 do if (i=1) or ((i>1) and (k<>2) and kt(copy(s,1,i-1)+d[k])) then begin s[i]:=d[k]; if i=n then begin Writeln(s); m:=m+1; end else tim(i+1); end; end; Begin clrscr; Write('Ban hay nhap so n:');Readln(n); s:=''; For i:=1 to n do s:=s+'0'; tim(1); Writeln('Co ',m,' so.'); Readln; End.

Bài 20. Tìm điểm yên ngựa Cho bảng số A kích thước m x n. Phần tử Aij (nằm ở hàng i, cột j ) được gọi là phần tử yên ngựa nếu nó là phần tử nhỏ nhất trong hàng i đồng thời là phần tử lớn nhất trong cột j ( hoặc là phần tử lớn nhất trong hàng i đồng thời là phần tử nhỏ nhất trong cột j ).Ví dụ trong 2 bảng số sau: Bảng 1: 15 3 9 55 4 6 76 1 2 Bảng 2:

15 55 9 3 4 1 7 6 2 Thì phần tử A2 2 = 4 là phần tử yên ngựa. Hãy lập chương trình nhập từ bàn phím một bảng số kích thước m x n và in ra các phần tử yên ngựa ( nếu có ).

uses crt; Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal var i,k,m,n,s:integer; a:array [1..100,1..100] of integer; h:array [1..100,1..2] of integer; c:array [1..100,1..2] of integer; kq:array [1..2,1..100] of integer; Procedure tim; Var i,k,z,p:integer; begin For i:=1 to n do begin h[i,1]:=1;h[i,2]:=1; For k:=2 to m do begin if a[k,i]a[h[i,2],i] then h[i,2]:=k; end; end; For i:=1 to m do begin c[i,1]:=1;c[i,2]:=1; For k:=2 to n do begin if a[i,k]a[i,c[i,2]] then c[i,2]:=k; end; end; end; Procedure tinh; begin For i:=1 to n do begin if c[h[i,1],2]=i then begin s:=s+1; kq[s,1]:=h[i,1]; kq[s,2]:=i; end; if c[h[i,2],1]=i then begin s:=s+1; kq[s,1]:=h[i,2]; kq[s,2]:=i; end; end; end; Begin clrscr; Write('Ban hay nhap so hang:');Readln(n); Write('Ban hay nhap so cot:');Readln(m); For k:=1 to n do For i:=1 to m do begin Write('Ban hay nhap phan tu A[',i,',',k,']:');Readln(a[i,k]); end; clrscr; For k:=1 to n do For i:=1 to m do begin Gotoxy(i*4,k);Write(a[i,k]); end; tim; tinh;Writeln; For i:=1 to s do Writeln('Phan tu A[',kq[i,1],',',kq[i,2],']=',a[kq[i,1],kq[i,2]],' la phan tu yen ngua.'); Readln; End. Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal Bài 21:Cho một dãy số bất kỳ. Hãy kiểm tra xem dãy đó được sắp xếp hay chưa? Nếu sắp xếp rồi thì: - Trả lời dãy đó được sắp xếp theo chiều tăng hay giảm? - Chèn một phần tử vào dãy đã sắp xếp đó sao cho thứ tự sắp xếp không thay đổi ( phải chèn trực tiếp, không được sắp xếp lại ). Nếu dãy chưa sắp xếp, hãy sắp xếp chúng theo chiều tăng dần. uses crt; var a:array [1..1000] of integer; i,j,k,m,n,ch,p:integer; c:char; Procedure nhap; begin Write('Ban hay nhap so phan tu:');Readln(n); k:=0; ch:=0; For i:=1 to n do begin Write('Nhap so thu ',i,':');Readln(a[i]); if (i>1) and (k=0) then begin if a[i]>a[i-1] then begin if ch=0 then ch:=1; if ch=2 then k:=1; end; if a[i]
Bài tập Pascal begin Repeat Write('Ban hay nhap phan tu muon chen:');Readln(m); n:=n+1; k:=0; For i:=1 to n do if ((ch in [0,1]) and (a[i]>m)) or ((ch=2) and (a[i]
– 1 x n–1

từ ma trận

Bài tập Pascal begin for j:=1 to n do if (i<>x) and (j<>y) then begin A[t,k]:=A[i,j];inc(k); end; if i<>x then inc(t); if (k>n-1) and (is then s:=d; inc(j); until j>=i; end; writeln(s); readln; end.


Bài tập Pascal Bài 25 Program baitap; Uses crt; Var i,j,us: Integer; a:array[1..10] of integer; Begin Randomize; For i:= 1 to 10 do a[i]:=random(99)+1; For i:= 1 to 10 do Write('Phan tu thu ',i,' =',a[i]; For i:= 1 to 10 do Begin Us:=0; For j:=2 to (i-1) do If (a[i] mod j)<>0 then us:=us+1; If Us<0> then write('Phan tu thu ',i,'=',a[i],' la so nguyen to'); end; Readln; End. Bài 27: var so_luong, vt_min, vt_max, i: integer; a: array[1..1000] of integer; BEGIN write('Nhap so luong phan tu: '); readln(so_luong); { nhap tung phan tu cua mang } for i:=1 to so_luong do begin write('a[', i, '] = '); readln(a[i]); end; { tim vi tri cua cac phan tu max, min } { gia su phan tu nho nhat va lon nhat deu nam o vi tri 1 } vt_min:=1; vt_max:=1; { so sanh voi cac phan tu con lai trong mang } for i:=2 to so_luong do begin if (a[i]>a[vt_max]) then vt_max:=i; if (a[i]

Bài tập Pascal C. BÀI TẬP VỀ XÂU Bài 1. Đếm số kí tự trong chuổi. Var a: array['A'..'Z'] of Integer; s: String; i: Integer; c: Char; Begin For c:= 'A' to 'Z' do a[c]:= 0; Write('Nhap chuoi S: '); Readln(s); For i:=1 to Length(s) do Begin c:= Upcase(s[i]); if ('A' <= c) and (c <= 'Z') then Inc(a[c]); End; For c:='A' to 'Z' do If a[c] > 0 then Writeln('Ky tu ',c,' xuat hien ',a[c],' lan.'); End. Bài 2. Xoá kí tự trắng trong xâu . Program ChuoiChuan; Var s, p : String; { Chuỗi gốc và kết quả } i, l, r : Byte; Begin Write('Nhap s:'); Readln(s); p := ''; { Chuỗi kết quả là rỗng } l := 1; { Chặn trái } r := Length(s); { Chặn phải } { Loại bỏ những khoảng trắng đầu } While (l <= r) and (s[l] = ' ') do Inc(l); { Loại bỏ những khoảng trắng cuối } While (r > l) and (s[r] = ' ') do Dec(r); For i := l to r do If (s[i] <> ' ') or (p[Length(p)] <> ' ') then p := p + s[i]; Writeln('Chuoi da chuan hoa:', p); Readln; End. Program ChuoiChuan; Var s : String; i : Byte; Begin Writeln('Nhap s: '); Readln(s); { Thêm khoảng trắng cầm canh đầu và cuối } s := ' ' + s + ' '; i := Pos(' ', s); While (i > 0) do Begin Delete(s, i, 1); i := Pos(' ', s); End; Delete(s, 1, 1); { Xóa cầm canh đầu } Delete(s, Length(s), 1); {Xóa cầm canh cuối } Writeln('Chuoi da chuan hoa: ', s); End.


Bài tập Pascal Bài 3. Kiểm tra xâu có đối xứng ko? Var s : String; i, j : Integer; BEGIN { Giả sử đã nhập chuỗi s } i := 1; j := Length(s); While (i < j) and (s[i] = s[j]) do Begin Inc(i); Dec(j); End; If (i < j) then Writeln('Chuoi khong doi xung') Else Writeln('Chuoi doi xung'); END. Viết bằng đệ quy Var OK: boolean; St: string; Procedure Doixung (Low, upp: byte; var OK: booolean); Begin If (st[upp] <> st[upp] then Begin Ok:= false; Exit; End Eslse If st[upp] > st[upp] then Begin Ok:= true; Exit; Else Doixung(st,low +1, upp – 1,ok); End; BEGIN Write (‘nhap xau:’); readln(st); Doixung(st,length(st),ok); Readln; END. Bài 4. Nhập vào một xâu ký tự. Hãy chuẩn hoá xâu bằng cách chỉ giữ lại một dấu cách giữa các từ. uses crt; var i,k,m,n:integer; s:string; Begin clrscr; Write('Ban hay nhap mot xau ki tu:');Readln(s); While Pos(' ',s)<>0 do Delete(s,Pos(' ',s),1); Writeln('Xau da chuan hoa:',s); Readln; End.


Bài tập Pascal Bài 5: Nhập vào một xâu ký tự bất kỳ. Hãy chuẩn hoá xâu đó bằng cách chỉ giữ lại một dấu trống (dấu cách) giữa các từ (từ được hiểu là một dãy các ký tự liên tiếp không chứa dấu cách). uses crt; var i,k,m,n:integer; s:string; Begin clrscr; Write('Ban hay nhap mot xau ki tu:');Readln(s); While Pos(' ',s)<>0 do Delete(s,Pos(' ',s),1); Writeln('Xau da chuan hoa:',s); Readln; End. Bài 6 program tim_kiem; uses crt; Var s1,s2:string; k,i,j:integer; Begin write('nhap s1:'); read(s1); write(nhap s2:'); read(s2) for i:=1 to length(s1) do i:=i+1; begin for j:=1 to length(s2) do j:=j+1; if k:=i:=j do write('so lan xuat hien s1 trong s2 la:',k); end; readln; End. Bài 7 : Chạy xâu trên màn hình Uses CRT; Var a : string; BEGIN Write('Nhập xâu : '); Readln(a); Repeat write(a); delay(500); a:= ' ' + a; clrscr; Until keypressed; Readln END.


Bài tập Pascal Bài 8 : uses crt; const m=...; {tuy loai man hinh ma cho do dai vao} var s,s1:string; i,d,dem,l:integer; BEGIN clrscr; write('Nhap xau: '); readln(s); clrscr; l:=length(s); for i:=1 to m-l do s:=s+' '; dem:=0; repeat if dem=0 then d:=1; if dem=m-l then d:=-1; write(s); delay(200); clrscr; if d=1 then s1:=s[m]+copy(s,1,m-1) else s1:=copy(s,2,m-1)+s[1]; s:=s1; dem:=dem+d; until keypressed; readln; END. Bài 9 : uses crt; var s:string; i,k,max,a,h:integer; begin clrscr; write('Nhap xau s: ');readln(s); while s[1]=#32 do delete(S,1,1); while s[length(S)]=#32 do delete(s,length(s),1); while pos(#32#32,s)>0 do delete(s,pos(#32#32,s),1); s:=s+#32; a:=1; max:=1; for i:=1 to length(S) do begin if s[i]=#32 then begin if i-a>max then begin max:=i-a; h:=a; k:=i-1; end; a:=i+1; end; end; for i:=h to k do write(s[i]);


Bài tập Pascal readln; End.

Bài 10 : Cho 1 biểu thức ngoặc chưa hoàn chỉnh. Hãy thực hiên các bước thêm các dâu ngoặc "(" hoặc ")" để được 1 biểu thức ngoặc đúng sao cho số bước là ít nhất. program ngoac; Var s,p : string; i : byte; sm : byte; Begin write('Input string: '); readln(s); p:=''; sm:=0; for i:= 1 to length(s) do if s[i]='(' then begin inc(sm); p:=p+s[i]; end else if s[i]=')' then if sm = 0 then p:=p+'()' else begin dec(sm); p:=p+s[i]; end else p:=p+s[i]; for i:= 1 to sm do p:=p+')'; writeln('Result: ',p); readln; End. Bài 11. Xâu nghịch đảo Hãy sử dụng kỹ thuật đệ quy trong lập trình để tìm xâu nghịch đảo của một xâu nhị phân cho trước (xâu nhị phân là xâu chỉ gồm hai kí tự ‘0’ và ‘1’). var i,k:integer; s:string; Procedure dao(i:integer); begin if i<=length(s) then begin if s[i]='0' then s[i]:='1' else s[i]:='0'; dao(i+1); end; end; Begin clrscr; Repeat Write('Ban hay nhap 1 xau nhi phan:');Readln(s); k:=0; For i:=1 to length(s) do if not (s[i] in ['0','1']) then begin k:=1;Break; end; Until k=0; dao(1); Writeln('Xau nghich dao:',s); Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal Readln; End. D. BÀI TậP Về BảN GHI Bài 1: Sắp xếp Program Xep_loai; uses crt; const max=60; Type hocsinh record hoten: string[20]; ngaysinh:string[10]; diachi:string[50]; toan,van:real; xeploai:char; end; Var lop:array[1..Max] of hocsinh; N.i:byte; Begin clrscr; write('so luong hoc sinh trong lop n=');readln(N); for i:=1 to N do begin writeln('nhap so lieu ve hoc sinh thu',i,':'); write('ho va ten:');readln(lop[i].hoten); write('ngay sinh:');readln(lop[i].ngaysinh); write('dia chi:');readln(lop[i].diachi); write('diem toan:');readln(lop[i].toan); write('diem van:');readln(lop[i].van); if lop[i].toan + lop[i].van >=18 then lop[i].xeploai:='A'; if (lop[i].toan + lop[i].van >=14) and (lop[i].toan + lop[i].van <18) then lop[i].xeploai:='B'; if (lop[i].toan + lop[i].van >=10) and (lop[i].toan + lop[i].van <14) then lop[i].xeploai:='C'; if (lop[i].toan + lop[i].van <10) then lop[i].xeploai:='D'; end; clrscr; writeln('danh sach xep loai hoc sinh trong lop:'); for i:=1 to N do writeln(lop[i].hoten:30,'-Xep loai:',lop[i].xeploai; readln End. Bài 2: uses crt; const max=200; type hocsinh=record diemtb,toan,hoa,sinh,ly,van,su,dia,tin,av,cn,gdcd, quocphong,theduc:longint; sbd,ten,xl:string; end; var lop: array [1..max] of hocsinh min:longint; n,i:byte; begin write('Nhap so hoc sinh:');readln(n); for i:=1 to n do begin write('nhap sbd h/s thu ',i,' :');readln(sbd.lop[i]); write('nhap ten h/s thu ',i,' :');readln(ten.lop[i]); write('nhap diem toan:');readln(toan.lop[i]); write('nhap diem hoa:');readln(hoa.lop[i]); Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal write('nhap diem sinh:');readln(sinh.lop[i]); write('nhap diem ly:');readln(ly.lop[i]); write('nhap diem van:');readln(van.lop[i]); write('nhap diem su:');readln(su.lop[i]); write('nhap diem dia:');readln(dia.lop[i]); write('nhap diem tin:');readln(tin.lop[i]); write('nhap diem av:');readln(av.lop[i]); write('nhap diem cn:');readln(cn.lop[i]); write('nhap diem gdcd:');readln(gdcd.lop[i]); write('nhap diem quoc phong:');readln(quocphong.lop[i]); write('nhap diem the duc:');readln(theduc.lop[i]); clrscr; diemtb.lop[i]:=(toan.lop[i]*2+hoa.lop[i]*2+sinh.lop[i]*2+ly.lop[i]*2+van.lop[i]+su.lop[i]+dia.lop[i] +tin.lop[i]+av.lop[i]+cn.lop[i]+gdcd.lop[i]+quocphong.lop[i]+theduc.lop[i])/17; min:=toan.lop[i]; if min>hoa.lop[i] then min:=hoa.lop[i]; if min>sinh.lop[i] then min:=sinh.lop[i]; if min>ly.lop[i] then min:=ly.lop[i]; if min>van.lop[i] then min:=van.lop[i]; if min>su.lop[i] then min:=su.lop[i]; if min>dia.lop[i] then min:=dia.lop[i]; if min>tin.lop[i] then min:=tin.lop[i]; if min>av.lop[i] then min:=av.lop[i]; if min>cn.lop[i] then min:=cn.lop[i]; if min>gdcd.lop[i] then min:=gdcd.lop[i]; if min>quocphong.lop[i] then min:=quocphong.lop[i]; if min>theduc.lop[i] then min:=theduc.lop[i]; if (diemtb.lop[i]>=8) and (min>=6.5) then xl.lop[i]:='Gioi' else if (diemtb.lop[i]>6.5) and (min>=5) then xl.lop[i]:='Kha' else if (diemtb.lop[i]>=5) and (min>=3.5) then xl.lop[i]:='TB' else if (diemtb.lop[i]>=3.5) and (min>=2) then xl.lop[i]:='Yeu' else then xl.lop[i]:='Kem'; end; {tu viet thu tuc xuat nha !!!} readln End. Bài 4 Program Bangi; uses crt; const Max=50; Type Hocsinh = record Hoten: string[30]; Ngaysinh:string[10]; Diachi:string[50]; Dvan,Dtoan,Tong:real; xeploai:char; end; var Lop:array[1..max] of Hocsinh; i,n:integer; Begin clrscr; writeln('Nhap vao danh sach Hoc sinh va diem tuong ung :'); write('Nhap so hoc sinh'); read(n); for i:=1 to n do begin writeln('Hoc sinh ', i); Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal write('Ho va ten:'); readln(lop[i].hoten); write('Ngay sinh: '); readln(Lop[i].ngaysinh); write('Dia Chi :'); read(Lop[i].Diachi); write(' Diem Van :'); read(lop[i].Dvan); write('Diem Toan :'); readln(lop[i].Dtoan); end; writeln(' Danh sach hoc sinh vua nhap la: '); for i:=1 to n do begin write(lop[i].Hoten, ' '); write(lop[i].ngaysinh,' '); write(lop[i].Diachi,' '); write(lop[i].Dtoan,' '); write(lop[i].Dvan, ' '); writeln; end; readln; end. Bài 5.Cho một tệp văn bản có tên VANBAN.PAS gồm 3 dòng chứa 3 xâu ký tự S 1 , S 2 , S 3 có độ dài tuỳ ý. Xâu S1 cần biến đổi như sau: lần lượt xét từng ký tự của S 1 . Nếu ký tự i của S 1 trùng với ký tự thứ j gặp đầu tiên tính từ bên trái của S 2 thì ký tự thứ i đó của S 1 được thay bằng ký tự thứ j của S 3 nếu có. Trong các trường hợp khác thì bỏ qua yêu cầu biến đổi S 1 . Mỗi bước, nếu có sự thay thế cần hiển thị lên màn hình dạng thông báo: (a, i, j, c) nghĩa là ký tự thứ i của S 1 là a được thay bằng ký tự thứ j của S 3 là c. - Hiển thị lên màn hình lần lượt S 1, S2, S3 ban đầu và S 1 sau khi biến đổi. uses crt; var i,k:integer; s1,s2,s3:string; f:Text; Begin clrscr; Assign(f,'vanban.pas'); Reset(f); Readln(f,s1); Readln(f,s2); Readln(f,s3); Close(f); Writeln('Ba xau ki tu ban dau:'); Writeln('S1=',s1); Writeln('S2=',s2); Writeln('S3=',s3); For i:=1 to length(s1) do begin k:=Pos(s1[i],s2); if (k>0) and (k
Bài tập Pascal Bài 6. Tần số xuất hiện chữ cái Cho tệp văn bản mang tên VANBAN.PAS. Hãy đưa ra một tệp văn bản mang tên KQVANBAN.PAS các chữ cái khác nhau trong tệp trên và số lần xuất hiện mỗi chữ cái đó. uses crt; var a:array [1..25] of integer; i:integer; c:char; f:Text; Begin clrscr; Assign(f,'vanban.pas'); Reset(f); While not eof(f) do begin Read(f,c); if Upcase(c) in ['A'..'Z'] then a[ord(Upcase(c))-64]:=a[ord(Upcase(c))-64]+1; end; Close(f); Assign(f,'kqvanban.pas'); Rewrite(f); For i:=1 to 25 do if a[i]>0 then Writeln(f,'Chu cai ',chr(96+i),' xuat hien',a[i],' lan.'); Close(f); End. Bài 7. Bài toán thay thế từ Hai file DLIEU1.TXT và DLIEU2.TXT được cho như sau: File DLIEU1.TXT chứa một đoạn văn bản bất kỳ. File DLIEU2.TXT chứa không quá 50 dòng. Mỗi dòng gồm 2 từ: Từ đầu là từ đích và từ sau là từ nguồn. Hãy lập chương trình tìm trong file DLIEU1.TXT tất cả các từ là từ đích và thay thế chúng bằng các từ nguồn tương ứng. Kết quả được ghi vào file KETQUA.TXT ( Đó là đoạn văn bản tương tự như trong file DLIEU1.TXT nhưng được thay thế từ đích bởi từ nguồn ).Ví dụ: File DLIEU1.TXT chứa đoạn văn bản: Nam hoc sap ket thuc roi, ban co zui khong? Chuc cac ban don mot ky nghi he that zui ze va hanh phuc. File DLIEU2.TXT chứa các dòng sau: ban em zui vui ze ve File KETQUA sẽ chứa đoạn văn bản sau: Nam hoc sap ket thuc roi, ban co vui khong? Chuc cac ban don mot ky nghi he that vui ve va hanh phuc. uses crt; var a:array [1..100] of string; i,k,m,n:integer; s,s1,s2:string; f:text; Procedure sua; begin While s[1]=' ' do Delete(s,1,1); s1:='';While s[1]<>' ' do begin s1:=s1+s[1];Delete(s,1,1);end; While Pos(' ',s)>0 do Delete(s,Pos(' ',s),1);s2:=s; Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal For i:=1 to n do begin if Pos(s1,a[i])>0 then begin k:=Pos(s1,a[i]); if (not (a[i,k-1] in and (not (a[i,k+length(s1)] in begin Delete(a[i],k,length(s1)); Insert(s2,a[i],k); end; end; end; end; Begin clrscr; Assign(f,'dlieu1.txt'); Reset(f); While not eof(f) do begin n:=n+1;Readln(f,a[n]); end; Close(f); Assign(f,'dlieu2.txt'); Reset(f); While not eof(f) do begin Readln(f,s);sua; end; Close(f); Assign(f,'ketqua.txt'); Rewrite(f); For i:=1 to n do Writeln(f,a[i]); Close(f); End. Bài 8. Trò chơi

['a'..'z','A'..'Z','0'..'9'])) ['a'..'z','A'..'Z','0'..'9'])) then

Trò chơi bốc kẹo là trò chơi cho 2 đối thủ. Người ta xếp N túi kẹo vòng quanh một chiếc bàn tròn và đánh số liên tiếp theo chiều kim đồng hồ từ 1 đến N bắt đầu từ một túi kẹo bất kỳ. Túi thứ i có ai cái kẹo. Hai đối thủ luân phiên thực hiện nước đi, mỗi nước đi phải lấy 1 túi kẹo. Đối thủ thứ nhất, là người thực hiện nước đi đầu tiên, được chọn và lấy 1 trong N túi kẹo. Tiếp theo, đối thủ đến lượt thực hiện nước đi phải chọn túi kẹo ở sát cạnh vị trí túi kẹo mà đối thủ thực hiện nước đi ngay trước đó vừa lấy. Trò chơi kết thúc khi trên mặt bàn không còn túi kẹo nào cả.

Yêu cầu: Cho biết chỉ số của túi kẹo mà đối thủ nhất lấy đi trong nước đi đầu tiên. Hãy tính tổng số kẹo lớn nhất mà đối thủ thứ hai có thể lấy được khi tham gia trò chơi này.Dữ liệu vào từ file văn bản GAME.INP - Dòng đầu tiên chứa số lượng túi kẹo N ( 1 ≤ N ≤ 1000). - Dòng thứ hai chứa số nguyên dương k là chỉ số của túi kẹo mà đối thủ thứ nhất chọn và lấy trong nước đi đầu tiên. ( ai ≤ 32767 ), i = 1, - Dòng thứ i trong số N dòng tiếp theo chứa số nguyên dương ai 2, ... N. Kết quả: Ghi ra file văn bản GAME.OUT tổng số kẹo lớn nhất tìm được. Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal Ví dụ: GAME.INP 5 1 2 2 3 9 5 Program game; Var a:array [1..1000] of integer; i,k,m,n:integer; f:Text; Procedure doc; begin Assign(f,'game.inp'); Reset(f); Readln(f,n); Readln(f,m); For i:=1 to n do Readln(f,a[i]); Close(f); end; Procedure tinh; begin k:=0; if m mod 2=0 then begin For i:=1 to n do if i mod 2=1 then k:=k+a[i]; end else For i:=1 to n do if i mod 2=0 then k:=k+a[i]; end; Procedure ghi; begin Assign(f,'game.out'); Rewrite(f); Writeln(f,k); Close(f); end; Begin doc; tinh; ghi; End.


GAME.OUT 11

Bài tập Pascal

Bài 9. Xếp khách Một khách dạn có N phòng đôi ( phòng cho 2 người ) được đánh số từ 1 đến N. Khi có một đoàn khách đến thuê phòng, tiếp tân của khách sạn sẽ xếp khách vào phòng theo quy tắc sau: Mỗi cặp khách sẽ được xếp vào phòng có chỉ số nhỏ nhất trong số các phòng trống. Nếu số lượng khách của đoàn là số lẻ thì người cuối cùng của đoàn khách sẽ được xếp vào phòng có chỉ số nhỏ nhất trong số các phòng trống. Nếu không còn phòng trống, thì số khách chưa có phòng sẽ được xếp tuần tự từng người một vào phòng có chỉ số nhỏ nhất trong số các phòng mới có một khách ở ( của đoàn khách đến trước ). Đầu tiên tất cả các phòng của khách sạn là trống.

Yêu cầu: Cho trước trình tự đến của các đoàn khách và số lượng khách của mỗi đoàn. Hãy xác định số lượng khách trong mỗi phòng của khách sạn. Dữ liệu: Vào từ file văn bản ROOM.INP: - Dòng đầu tiên chứa 2 số nguyên dương N ( 1 ≤ N ≤ 100) và G được ghi cách nhau bởi dấu cách. N là số phòng của khách sạn, G là số lượng đoàn khách. - Dòng thứ i trong số G dòng tiếp theo chứa số lượng khách của đoàn khách thứ i ( các đoàn khách được đánh số theo thứ tự đến khách sạn bắt đầu từ 1 ). Giả thiết rằng không có 2 đoàn khách nào đến khách sạn vào cùng một thời điểm và tổng số khách của tất cả các đoàn không vượt quá sức chứa của khách sạn ( ≤ 2N ). Kết quả: Ghi ra file văn bản ROOMS.OUT N dòng: Dòng thứ i chứa số lượng khách của phòng i ( 1 ≤ i ≤ N ).Ví dụ: ROOMS.INP 7 3 3 1 4

Program room; var a,b:array [1..1000] of integer; i,k,m,n,p,q:integer; f:Text; Procedure doc; begin Assign(f,'room.inp'); Reset(f); Readln(f,n,m); For i:=1 to m do Readln(f,a[i]); Close(f); end; Procedure tinh; Sưu tầm và biên soạn: Nguyễn Minh Đức

ROOMS.OUT 2 1 1 2 2 0 0

Bài tập Pascal begin For i:=1 to m do begin p:=a[i];k:=0; Repeat k:=k+1; if b[k]=0 then if p>1 then begin b[k]:=2;p:=p-2;end else begin b[k]:=1;p:=0;end; Until (k>=n) or (p=0); if p>0 then begin k:=0; Repeat k:=k+1; if b[k]=1 then begin b[k]:=2;p:=p-1;end; Until (k>=n) or (p=0); end; end; end; Procedure ghi; begin Assign(f,'room.out'); Rewrite(f); For i:=1 to n do Writeln(f,b[i]); Close(f); end; Begin doc; tinh; ghi; End. Bài 10. Bài toán thay thế từ Hai file DLIEU1.TXT và DLIEU2.TXT được cho như sau: File DLIEU1.TXT chứa một đoạn văn bản bất kỳ. File DLIEU2.TXT chứa không quá 50 dòng. Mỗi dòng gồm 2 từ: Từ đầu là từ đích và từ sau là từ nguồn. Hãy lập chương trình tìm trong file DLIEU1.TXT tất cả các từ là từ đích và thay thế chúng bằng các từ nguồn tương ứng. Kết quả được ghi vào file KETQUA.TXT ( Đó là đoạn văn bản tương tự như trong file DLIEU1.TXT nhưng được thay thế từ đích bởi từ nguồn ).Ví dụ: File DLIEU1.TXT chứa đoạn văn bản: Nam hoc sap ket thuc roi, ban co zui khong? Chuc cac ban don mot ky nghi he that zui ze va hanh phuc. File DLIEU2.TXT chứa các dòng sau: ban em zui vui ze ve File KETQUA sẽ chứa đoạn văn bản sau: Nam hoc sap ket thuc roi, ban co vui khong? Chuc cac ban don mot ky nghi he that vui ve va hanh phuc. uses crt; var a:array [1..100] of string; i,k,m,n:integer; s,s1,s2:string; f:text; Procedure sua; Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal begin While s[1]=' ' do Delete(s,1,1); s1:='';While s[1]<>' ' do begin s1:=s1+s[1];Delete(s,1,1);end; While Pos(' ',s)>0 do Delete(s,Pos(' ',s),1);s2:=s; For i:=1 to n do begin if Pos(s1,a[i])>0 then begin k:=Pos(s1,a[i]); if (not (a[i,k-1] in ['a'..'z','A'..'Z','0'..'9'])) and (not (a[i,k+length(s1)] in ['a'..'z','A'..'Z','0'..'9'])) then begin Delete(a[i],k,length(s1)); Insert(s2,a[i],k); end; end; end; end; Begin clrscr; Assign(f,'dlieu1.txt'); Reset(f); While not eof(f) do begin n:=n+1;Readln(f,a[n]); end; Close(f); Assign(f,'dlieu2.txt'); Reset(f); While not eof(f) do begin Readln(f,s);sua; end; Close(f); Assign(f,'ketqua.txt'); Rewrite(f); For i:=1 to n do Writeln(f,a[i]); Close(f); End.

Bài 11. Hình vuông Cho một lưới K x N điểm gồm K dòng và N cột ( 2 ≤ K, N ≤ 9 ) là các điểm nút của một lưới ô vuông ( các dòng được đánh số từ trên xuống dưới, các cột được đánh số từ trái qua phải bắt đầu từ 1 ). Trên lưới điểm đó cho một số đoạn thẳng, mỗi đoạn nối một cặp điểm cạnh nhau trên cùng một dòng ( đoạn ngang ) hoặc trên cùng một cột ( đoạn dọc ). Cần phải đếm số các hình vuông với kích thước nhất định được tạo thành bởi các đoạn thẳng đã cho của lưới nêu trên. Chẳng hạn ở hình 1 dưới đây có 3 hình vuông; 2 hình kích thước 1 và 1 hình kích thước 2 ( kích thước của hình vuông là số các đoạn thẳng tạo thành 1 cạnh của hình vuông ).


Bài tập Pascal

Hình 1 Yêu cầu: Hãy xác định số lượng các loại hình vuông và số hình vuông mỗi loại trong lưới điểm đã cho ( hình vuông có cùng kích thước được xếp vào cùng một loại ).

Dữ liệu: Vào từ file văn bản SQUARE.INP có khuôn dạng như sau: Dòng 1 chứa số nguyên N là số cột của lưới. • Dòng 2 chứa số nguyên M là số các đoạn thẳng được cho trên lưới. • dòng trong M dòng tiếp theo có 1 trong 2 dạng sau: • Mỗi H i j chỉ một đoạn ngang trên dòng thứ i nối hai điểm ở cột j và cột j+1. Hoặc: V j i chỉ một đoạn dọc trên cột thứ j nối hai điểm ở dòng i và dòng i +1. Số liệu được ghi từ vị trí đầu tiên của mỗi dòng, giữa ký tự và số và giữa hai số liên tiếp trên một dòng có đúng một dấu cách.

Kết quả: Ghi ra file văn bản SQUARE.OUT • Dòng đầu tiên ghi số nguyên P là số loại hình vuông có trên lưới. • Mỗi dòng trong P dòng tiếp theo ghi thông tin mô tả về một loại hình vuông và số lượng hình vuông đó bao gồm hai số nguyên a, b cho biết có a hình vuông có cạnh độ dài b. Các thông tin về các loại hình vuông phải được đưa ra theo thứ tự tăng dần của độ dài cạnh. • Trong trường hợp không tìm được bất cứ một hình vuông nào file SQUARE.OUT gồm một dòng duy nhất chứa thông báo “NO SQUARES”. Ví dụ: File dữ liệu mô tả lưới cho trong hình 1 và file kết quả tương ứng có dạng: SQUARE.INP SQUARE.OUT 4 2 16 2 1 H 1 1 1 2 H 1 3 H 2 1 H 2 2 H 2 3 H 3 2 H 4 2 H 4 3 V 1 1 V 2 1 V 2 2 V 2 3 V 3 2 V 4 1 V 4 2 V 4 3 Program square; Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal var a:array [1..100,1..100] of integer; b,kq:array [1..1000,1..2] of integer; i,k,m,n,p,q,z,s,l:integer; c:char; f:Text; Procedure kt(x1,y1,x2,y2:integer); var i,k,t,p,q:integer; begin t:=0; i:=0; k:=x2-x1; Repeat i:=i+1; if a[x1+i,y1]=0 then t:=1; if a[x1+i,y2]=0 then t:=1; if a[x1,y1+i]=0 then t:=1; if a[x2,y1+i]=0 then t:=1; Until (i=k) or (t=1); if t=0 then begin q:=0; For p:=1 to l do if kq[p,2]=k div 2 then begin kq[p,1]:=kq[p,1]+1;q:=1;Break;end; if q=0 then begin l:=l+1;kq[l,1]:=1;kq[l,2]:=k div 2; end; end; end; Procedure doc; begin Assign(f,'square.inp'); Reset(f); Readln(f,m); Readln(f,k); For i:=1 to k do begin Repeat Read(f,c); Until Upcase(c) in ['H','V']; if c='H' then Readln(f,q,p) else Readln(f,p,q); if n
Bài tập Pascal end; Procedure tinh; begin For i:=1 to n-1 do For k:=1 to m-1 do if a[i*2-1,k*2-1]=1 then For p:=1 to m-i do kt(i*2-1,k*2-1,i*2-1+p*2,k*2-1+p*2); end; Procedure ghi; begin Assign(f,'square.out'); Rewrite(f); Writeln(f,l); For i:=1 to l do Writeln(f,kq[i,1],' ',kq[i,2]); Close(f); end; Begin doc; tinh; ghi; End. Bài 12.Hai xâu ký tự được gọi là ANAGRAM của nhau nếu xâu này có thể tạo được bằng cách hoán vị các ký tự của xâu kia, từ đơn được hiểu là xâu ký tự viết liền nhau không chứa dấu cách. Cho một tệp văn bản bất kỳ có tên VANBAN.TXT, hãy lập trình để hiện lên màn hình những nhóm từ là ANAGRAM của nhau bằng cách xét các từ trong tệp văn bản đã cho. uses crt; var a,b:array[1..100] of string; c:array[1..100,1..2] of word; i,j,k,m,n:word; s:string; f:text; Procedure chg(k:integer); var i,j:word; c:char; begin b[k]:=a[k]; For i:=1 to length(b[k]) do For j:=i+1 to length(b[k]) do if b[k,j]0 do Delete(s,pos(' ',s),1); If s[length(s)]=' ' then Delete(s,length(s),1); s:=s+' '; if s[1]=' ' then Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal Delete(s,1,1); While s<>'' do begin inc(n); a[n]:=copy(s,1,pos(' ',s)-1); Delete(s,1,pos(' ',s)); chg(n); For i:=1 to n-1 do if b[i]=b[n] then Writeln(a[i],' ',a[n]); end; end; Begin clrscr; Assign(f,'vanban.txt'); Reset(f); i:=0; n:=0; While not eof(f) do begin inc(i); Readln(f,s); xl; end; Close(f); Readln; End. Bài 13. Mã số sách Để đánh mã số cho từng quyển sách, một cán bộ thư viện dự định dùng một từ có 5 kí hiệu liên tiếp nhau gồm : 2 kí tự (A....Z) tiếp theo là 3 kí số (001...999). Em hãy lập trình tạo tất cả từ có thể dùng làm mã số. Yêu cầu kĩ thuật Xuất : File text MASO.INP Mỗi dòng có 8 từ, mỗi từ cách nhau một khoảng trống. Ghi chú:Mã số sách không có 3 kí hiệu cuối là 000 uses crt; var i,k,m,n:integer; s,s2:string; f:text; Begin Assign(f,'maso.inp'); Rewrite(f); For i:=1 to 25 do For k:=1 to 25 do For m:=1 to 999 do begin Str(m,s); While length(s)<3 do s:='0'+s; Write(f,chr(i+64)+chr(k+64)+s,' '); n:=n+1; if n mod 8=0 then begin Writeln(f);n:=0; end; end; Close(f); End. Bài 14. Nhận dạng hằng số thực (real con-stant) Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal Người ta định nghĩa, một hằng số được coi là số thực nếu ngoài các số chữ số ra nó còn có dấu chấm ( . ) hoặc một số mũ ( bắt đầu bởi e hay E thường được gọi là số luỹ thừa ) hoặc cả hai. Nếu có dấu chấm ( . ) thì mỗi bên của dấu chấm phải có ít nhất một chữ số. Ngoài ra, ở trước số và trong số mũ còn có thể có một dấu cộng ( + ) hoặc trừ ( - ). Phần số luỹ thừa phải là số nguyên. Số thực có thể có các khoảng trông ( BLANK ) ở trước hoặc sau nhưng bên trong thì không. Hằng số thực không có giới hạn về giá trị. Viết chương trình kiểm tra xem các chuỗi kí tự cho trước có phải là những số thực theo định nghĩa trên đây hay không. Dữ liệu vào: Dữ liệu vào cho trong tập tin văn bản SOTHUC.INP gồm nhiều dòng cho nhiều trường hợp cần kiểm tra. Mỗi dòng chứa một chuỗi kí thự Si là chuỗi cần kiểm tra. Dòng cuối cùng chứa kí tự ' * ', dòng này không được xét trong chương trình. Mỗi dòng tối đa 255 kí tự.

Dữ liệu ra Kết quả ghi trong tập tin văn bản SOTHUC.OUT gồm nhiều dòng. Mỗi dòng chứa câu trả lời là "DUNG" hoặc "SAI" tương ứng với một dòng trong tập tin SOTHUC.INP. Ví dụ: Dữ liệu vào Dữ liệu ra 1,2 DUNG 5,300 DUNG 1 SAI 1.0e55 DUNG +1e-12 DUNG 6 SAI e-12 SAI *. Program sothuc; uses crt; var i,k,m,n:integer; s,s2:string; f,f2:text; Function kt(s:string):string; var b:string; begin b:='DUNG'; While s[1]=' ' do Delete(s,1,1); While s[length(s)]=' ' do Delete(s,length(s),1); if pos(' ',s)>0 then b:='SAI' else begin For i:=1 to length(s) do begin s[i]:=Upcase(s[i]); if not (s[i] in ['0'..'9']) then begin if not (s[i] in ['+','-','E','.',',']) then b:='SAI'; if i=length(s) then b:='SAI'; Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal if not ((s[i] in ['+','-']) and ((i=1) or (s[i-1]='E'))) then b:='SAI'; if (s[i]='E') and (pos('.',s)>i) then b:='SAI'; if b='SAI' then Break; end; end; if (pos('.',s)=0) and (pos('E',s)=0) then b:='SAI' else begin k:=0; For i:=pos('.',s)+1 to length(s) do if s[i] in ['0'..'9'] then begin k:=1;Break; end; if k=0 then b:='SAI'; if pos('E',s)=length(s) then b:='SAI'; if pos('.',s)=0 then Delete(s,pos('.',s),1); if pos('E',s)=0 then Delete(s,pos('E',s),1); if (pos('.',s)>0) or (pos('E',s)>0) then b:='SAI' end; end; kt:=b; end; Begin clrscr; Assign(f,'sothuc.inp'); Assign(f2,'sothuc.out'); Reset(f); Rewrite(f2); While not eof(f) do begin Readln(f,s); if pos('*',s)<>0 then break; Writeln(f2,kt(s)); end; Close(f); Close(f2); End. Bài 15. Chuỗi đối xứng Mỗi chuỗi kí tự được gọi là đối xứng nếu nó có không ít hơn 1 kí tự và nếu ta đọc từ phải sang trái hay từ trái sang phải đều giống nhau. Ví dụ ' Z ' , ' TOT ' , ' NAN ' là các chuỗi đối xứng còn ' NAM ' không phải.Yêu cầu: Viết chương trình nhận vào chuỗi kí tự cho trước S và hãy cho biết có bao nhiêu chuỗi con khác nhau của S là chuỗi đối xứng. Chuỗi con của S là chuỗi gồm một số kí tự nằm liên tiếp nhau trong S. Dữ liệu vào cho trong tập tin văn bản CHUOI.INP gồm nhiều dòng, mỗi dòng là một chuỗi kí tự cần xem xét(các chuỗi có độ dài không quá 80 kí tự ). Kết quả ghi trong tập tin văn bản CHUOI.OUT có số dòng bằng với số dòng của CHUOI.INP. Mỗi dòng chứa một số nguyên là con số cho biết số chuỗi con đối xứng của chuỗi ở dòng tương ứng trong CHUOI.INP.Ví dụ: Dữ liệu vào: Sưu tầm và biên soạn: Nguyễn Minh Đức

Dữ liệu ra:

Bài tập Pascal Z

1

TOT

3

NANG 4 program chuoi; use crt; var s:string; f,f1:text; a:array[1..200] of string; Function dx(s:string):boolean; var bl:boolean; i:word; Begin bl:=true; For i:=1 to length(s) do If s[i] <> s[length(s)-i+1] then bl:=false; dx:=bl; End; Function from(s:string;d:word):boolean; var i:word; bl:boolean; Begin bl:=false; If d=0 then bl:=false Else For i:=1 to d do If s=a[i] then bl:=true; from:=bl; End; Function xet(s:string):word; var s1:string; d,i,j:word; Begin fillchar(a,sizeof(a),0); d:=0; For i:=1 to length(s) do For j:=1 to length(s)-i+1 do Begin s1:=copy(s,i,j); If dx(s1) then If not from(s1,d) then Begin inc(d); a[d]:=s1; End; End; xet:=d; End; Begin assign(f,'chuoi.inp'); Reset(f); assign(f1,'chuoi.out'); Rewrite(f1); While not eof(f) do Begin Readln(f,s); Writeln(f1,xet(s)); End; Close(f);Close(f1); End. Bài 16. Cho dãy số nguyên A = {a 1, a2, a3, ..., a n} và một số K (được nhập vào từ phím). Hãy viết chương trình in ra tất cả các phần tử mà tổng các phần tử đó bằng K. Mỗi phần tử được sử dụng một lần Sưu tầm và biên soạn: Nguyễn Minh Đức

Bài tập Pascal Ví dụ: A= {2 3 6 7 1 4 5}; K=5 Ta có các dãy số là: {2 3}; {1 4} Const fi='ptk.inp'; fo='ptk.out'; nmax = 100; var n:Byte; k:Integer; a:array[1..nmax] of integer; cx:array[1..nmax] of boolean; f:text; procedure Dulieu; Var f:text; i:byte; Begin assign(f,fi); reset(f); readln(f,n,k); for i:=1 to n do read(f,a[i]); close(f); end; procedure ghinhan; var i:integer; begin for i:=1 to n do if not cx[i] then write(f,a[i]:5); writeln(f); end; procedure try(S:Integer;i:byte); var j:byte; Begin if S = 0 then ghinhan else begin for j:=i to n do if cx[j] then begin cx[j]:=false; try(s-a[j],j+1); cx[j]:=true; end; end; End; BEGIN Dulieu; assign(f,fo); rewrite(f); fillchar(cx,sizeof(cx),true); Try(K,1); close(f); END.

1 số bài pascal...


bai tâp pascal

Recommend Documents