Bài giảng Môn Tin học lớp 11 - Bài tập Pascal nâng cao

------------------');
 writeln(' Nhap tung phan tu cua mang: ');
 for i := 1 to n do
 repeat
 write('A[',i,']='); readln(a[i]);
 if (a[i]>=2) or (a[i]<= -2) then
 writeln('phan tu cua mang phai nho hon 2 va lon hon -2');
 until (a[i]>(-2)) and (a[i] < 2);
 writeln('mang vua nhap la: ');
 for i:= 1 to n do
 begin
 write(a[i]:7:1);
 end;
 writeln;
 end;
function TB:real; {-----ham phan b--------}
 var k: word;S:real;
 begin
 S:= 0; k:=0;
 for i:=1 to n do
 if a[i]>0 then
 begin
 S:=S + a[i];
 k:=k+1;
 end;
 TB:= s/k;
 end;
procedure sosanh;
 var j,k: byte;
 begin
 j:=0; k:=0;
 for i:=1 to n do
 if a[i]>0 then j:=j+1
 else if a[i]<0 then k:=k+1;
 if j>k then writeln('So phan tu duong lon hon so phan tu am')
 else if j=k then writeln(' So phan tu duong bang so phan tu am')
 else writeln('So phan tu duong nho hon so phan tu am');
 end;
BEGIN
 clrscr;
 repeat
 nhap;
 writeln('TB cong cac phan tu duong cua mang la: ', TB:0:2);
 sosanh;
 readln;
 write('Tiep tuc c/k ?'); readln(x);
 until (x='k') or (x='K');
END.
BT4_T103: Cã n ng­êi xÕp hµng mét ®Ó mua hµng. Thêi gian ng­êi b¸n hµng phôc vô kh¸ch hµng thø i lµ ti. ViÕt ch­¬ng tr×nh nhËn vµo c¸c ti vµ tÝnh thêi gian ci mµ kh¸ch hµng thø i ph¶i chê ®Ó b¾t ®Çu ®Õn l­ît m×nh.
Program BT4_103; uses crt;
Const n = 10;
Var t: array [1..n] of integer; 
Procedure nhap;
 Var i,m: byte;
 Begin 
	 Write(‘Nhap vao so nguoi mua hang: ‘); Readln(m);
	For i:=1 to m do
	 Begin
	Write(‘thoi gian (tinh theo phut) nguoi ban hang phuc vu khach hang thu ‘,i,’ la: ‘); 
	Readln(t[i]);
	 End;
 End; 
Procedure tinhc;
 Var k,i: byte; c: integer; tl: string;
 Begin 
	 C:=0;
	repeat
	Write(‘Nhap vao vi tri cua khach can tinh thoi gian phai cho den luot: ‘);
	Readln(k);
	For i:=1 to k-1 do C:= c + t[i];
	Writeln(‘vi khach thu ‘,k,’ phai cho mot khoang thoi gian la: ‘,c ,' phut ' );
	C:= 0;
Writeln(‘tiep tuc c/k? ‘); readln(tl);
 Until (tl=’k’) or (tl=’K’);
 End;
BEGIN
 Clrscr;
 Nhap;
	Tinhc;
	Readln;
END.
------------------------------------------------------------------------
BT3 _T103: Cho n sè thùc (n>7) a1, a2, … , an . H·y tÝnh:
 ; 
Program BT3_103 
Const n=8;
Type: MG=array [1..n] of real;
Var a: MG; i,n : integer; p,q,a,s: real;
BEGIN
	Writeln(‘Nhap vao cac so thuc’); 
	For i:=1 to n do
	 Begin 
 Write(‘a[‘,i,’] =’); readln(a[i]);
 End;
P:=0; Q:=0;
For i:=1 to n do
 Begin
	P:=P + a[i]; A:=p/n; { Xem lai cong thuc}
	Q:= Q + sqr(a[i] – A); S:= sqrt(Q/(n-1));
 End;
Writeln(‘a = ’,A:0:2); writeln(‘S = ‘,S:0:2);
Readln;
END.
---------------------------------------------
 BT5_T103: cho A[1..n] (n>7), c¸c phÇn tö lµ sè tù nhiªn víi a[i] = i2 + 2.
	a) TÝnh tæng c¸c c¨n bËc hai cña c¸c phÇn tö chia cho 7 d­ 3.
	b) T×m c¸c phÇn tö lµ sè nguyªn tè cña m¶ng. ChØ ra vÞ trÝ vµ gi¸ trÞ cña chóng.
	c) x©y dùng m¶ng B cã c¸c phÇn tö lµ c¸c sè nguyªn tè cña m¶ng A. 
Program BT5_103; uses crt;
Const n=8;
Type MG=array[1..n] of word;
Var A : MG; i: byte;
Procedure tinh;
 Var c : real;
 Begin
 C:=0;
	 For i := 1 to n do
 If a[i] mod 7 = 3 then
 C:= C+ sqrt(a[i]);
	 Writeln('tong = ',c:0:2);
 End;
Function SNT(x: word): boolean;
 Var k: word;
 Begin
	SNT := false;
 if (x = 2) or (x = 3) then SNT:= true;
	For k := 2 to trunc(sqrt(x)) do
	 Begin
	If (x mod k )=0 then exit;
	 SNT:= true;
 End;
	End;
 BEGIN
	Clrscr;
	Writeln('Nhap tung phan tu cua mang');
	For i:= 1 to n do
	 Begin 
	Write('a[',i,']='); readln(a[i]);
	 End;
	Tinh;
	Writeln('cac so nguyen to la: ');
	For i:= 1 to n do
 If SNT(a[i]) then 
 Begin
 write(a[i]:4); writeln('vi tri thu ',i);
	 end;
	writeln('mang B la: ');
	for i:= 1 to n do
	 if SNT(a[i]) then write(a[i]:5);
	readln;	
 END.
----------------------------------------------------
{BT6_114. Cho ma trËn A[m,n] vµ ma trËn B[n,p], c¸c phÇn tö c¶a chóng lµ sè thùc. ViÕt ch­¬ng tr×nh nhËn vµo c¸c ma trËn A, B vµ cho in lªn mµn h×nh ma trËn C lµ tÝch cña A víi B }
Program Tichmatran;
const M = 3; N = 3; P = 2;
Var A, B, C : Array [1..n,1..n] of Integer;
 i, j, k : Integer;
BEGIN
 (*Doc vao gia tri cua ma tran A*)
 Writeln('Ma tran A:');
 For i:=1 to m do
 For k := 1 to n do
 Begin
 Write(' A[',i,',',k,']= '); readln(A[i,k]);
 End;
 (*Doc vao gia tri cua ma tran B*)
 Writeln('Ma tran B:');
 For k:=1 to n do
 For j := 1 to p do
 Begin
 Write(' B[',k,',',j,']= '); readln(B[k,j]);
 End;
 (*Nhan hai ma tran *)
 For i:= 1 to m do
 For j:= 1 to p do
 Begin
 C[i,j]:=0;
 For k := 1 to n do
 C[i,j] := C[i,j] + A[i,k]*B[k,j];
 End;
 (*In ket qua theo kieu viet ma tran*)
 Writeln('Ma tran C, la tich cua hai ma tran A va B: ');
 For i := 1 to m do
 Begin
 For j := 1 to p do write(c[i,j]:5);
 writeln;
 End;
 Readln;
END.
-----------------------------------------------------------------------------------
Program BT10_162; 
Const n = 10;
Type MG: array[1..n] of integer;
Var A, B, C : MG; i: byte;
Procedure nhap(var X: MG; T: char);
 Begin
	Writeln(‘Nhap tung phan tu cua mang ’,T);
	For i:=1 to n do
	Repeat
	Write(T,’[‘,i,’]=’); readln(x[i];
	If (x[i] 2000) then writeln(‘vao lai‘);
	Until (x[i] > 2) and (x[i] < 2000);
 End;
Function P (K: integer): word;
 Var tong, sochu: integer;
	Begin
	tong :=0; sochu := 0
	While K > 0 do Begin
	sochu := sochu + 1;
	Tong := tong + k mod 10;
	K := K div 10;
	 End;
	P := tong * sochu;
	End;
Procedure MgC;
	Begin
	For i := 1 to n do c[i] := P(a[i]) + P(b[i]);
	End;
Function SNT (M: integer): boolean;
	Var j: byte;
 Begin
	SNT := 0;
	For j := 1 to trunc (sqrt(M)) do
	If M mod j = 0 then Exit;
	SNT := 1;
	End;
Procedure IKQ(X: MG; T : char);
 	Begin
	Writeln(‘----------------------day la mang ‘,T,’---------------------------‘);
	For i := 1 to n do write (X[i] : 7); writeln;
	Writeln(‘ mang ’,T,’ co cac so nguyen to la: ‘);
	For i:= 1 to n do if SNT(X[i]) = 1 then write(X[i] : 7);
	End;
BEGIN
END.
------------------- C¸ch 2 (®· ch¹y) ------------------------
{Bai 10 Viet chuong trinh cho may tin lam viec nhu sau
a) Nhan vao hai day so co n phan tu la cac so nguyen > 2, 9)
 a1, a2, a3, ..., an (day A)
 b1, b2, b3, ..., bn (day B)
b) Goi P(k) la tich cua tong cac chu so cua k va so chu so cua k (VD: P(235)= 10 * 3 = 30)
Xay dung day C co n phan tu duoc tao thanh tu hai day tren sao cho Ci= P(Ai)+P(Bi) voi <=1i<=n.
c) In len man hinh cac so nguyen to cua tung day
d) In len man hinh cac phan tu nho hon tat ca cac phan tu o sau no cua tung day
e) In le man hinh cac phan tu la boi cua tat ca cac phan tu o truoc no cua tung day
g) In len man hinh cac day con lien tuc tang nghiem ngatco so phan tu lon nhat cua tung day A, B, C
Chi ra vi tri phan tu dau tien va cuoi cung, so phan tu, cac phan tu trong day con do
VD - 16,25,17,25,36,45,31,45,45,11,47,34,37,12,48. Ket qua la day con tu phan tu thu 3 den phan tu thu 6
so phan tu la 4 cac p tu la 17, 25, 36, 45 }
Program M1C; Uses crt;
COnst n=5;
Type MG=array[1..N] of Word;
Var A, B, C: MG; k:byte;
Procedure Nhap(var X:MG; T:char);
Begin
	Writeln('Moi ban nhap vao mang ', T, '=');
	For K:=1 to N do
 	Repeat
 	Write(T,'[',k,']='); Readln(X[k]);
 	If (x[k] = 2000) then Writeln('Moi ban vao lai');
 	Until (x[k] >= 2) and (x[k] < 2000);
End;
Function P(K:byte): Byte;
	Var X:mg; T: Byte;
	Begin
 	T:=0; While K > 0 do
 	 Begin T:=T+ K mod 10;
 	K:=K div 10;
 	 End;
 	P:=T;
	End;
Function CSK(K:word):Word;
	Var a,b,c,d, T,i: byte;
	Begin
	A:=0; b:=0; c:=0; d:=0; T:=0;
	IF k>0 then
 	begin
 	 	a:=k div 1000;
 	b:=(k mod 1000) div 100;
 	c:= ((k mod 1000) mod 100) div 10;
 	d:= k mod 10;
 	 If (a=0) and (b = 0) and (c=0) then T:=1;
 	 IF (a=0) and (b=0) and (c 0) then T:=2;
 	 If (a= 0) and (b 0) then T:=3;
 	IF a0 then T:=4;
 	End;
	CSK:=T;
	End;
Procedure MangC;
	Begin
 	For K:=1 to n Do
 	Begin
 	C[k]:= P(A[k]) * CSK(A[k]) + P(B[k])* CSK(B[k]) ;
 	End;
	End;
Function NT(K:byte):Boolean;
	Var u: Byte;
	Begin
 	Nt:= False;
 	For U:=2 to trunc(sqrt(K)) do
 	If K mod u = 0 then exit;
 	Nt:= N>1;
	End;
Procedure PTNN (X:MG; T:char);
	Var Max:Word;
	Begin
	Writeln('Cac phan tu nho hon tat ca cac phan tu sau no gom:');
	max:=X[N];
 	k:=N-1;
 	repeat
 	if X[k]<max then
 	 begin
 	write(X[K]:5);
 	max:=X[K];
 	end;
 	K:=K-1;
 	until K=0;
 	Writeln;
	End;
Procedure BSC(X:MG; T: char);
	Var	i,j: Byte;
	Begin
	 Writeln('Cac so la boi so chung cua tat ca cac so truoc no :');
	For i:= 2 to n do
 	Begin
 	For j:=1 to i-1 do
 	If X[i] mod x[j] 0 then begin break; end;
 	IF X[i] mod x[j] = 0 then Write(x[i]:7);
 	End;
	Writeln;
	end;
Procedure InKQ(X : MG; T : Char);
	Begin
 	Writeln('--------Day la mang ',T,'---------');
 	For k:=1 to N do begin Write(X[k]:7); end;
 	 writeln;
 	Writeln('cac phan tu la so nguyen to gom: ');
 	For k:=1 to n do If NT( X[k]) then Write(X[k]:6);
 	Writeln;
	End;
BEGIN
 	Clrscr;
 	 Nhap(A,'A'); Nhap(B,'B'); MangC;
 	InKQ(A,'A'); PTNN(A,'A'); BSC(A,'A');
 	InKQ(B,'B'); PTNN(B,'B'); BSC(B,'B');
 	InKQ(C,'C'); PTNN(C,'C'); BSC(C,'C');
	Readln;
END.
-----------------------------------------------------------------------------------
{Bai 12 Viet chuong trinh cho may tinh lam nhung viec sau:
a) Nhan vao mang A va B la mang 2 chieu gom n dong n cot, cacs phan tu la nhung so nguyen lon hon 3, nho hon 300
(n>5) chi so dong vaf chi so cot bat dau tu 1
b) Goij P(k) la tich cua tong cacs chu so cua K va cac uoc cua K 
(VD P(25)= (2+5)*(1+5+25)= 217
Xay dung va in len mang C co n dong n cot duoc tao thanh tu hai mang tren sao cho
C[i,j] = P(A[i,j]) + P(B[i,j]) voi 1<=i<=n va 1<=j<=n
c) In len man hinh phan tu lon nhat cua duong cheo chinh coar tung mang A, B, C
d) In len man hinh cacs phan tu la nguyen to cung nhau voi phan tu o dong 1 cot 1
e) In len man hinh tong cac pha tu nam phia duoi duong cheo phu, in rieng cho tung mang}
Program M1C; Uses crt;
COnst n=3;
Type MG=array[1..N,1..N] of Byte;
Var A, B, C: MG; i,j:byte;
Procedure Nhap(var X:MG; T:char);
Begin
	Writeln('Moi ban nhap vao mang ', T, '=');
	For i:=1 to N do
 	For j:=1 to N do
 	Repeat
 	Write(T,'[' , i , ' , ' , j , ' ]='); Readln(X[i,j]);
 	If (x[i,j] = 300) then Writeln('Moi ban vao lai');
 	 Until (x[i,j] >= 3) and (x[i,j] < 300);
End;
Function UC(K:byte): Byte;
 	var T,U: Byte;
	Begin
 	T:=1+k;
 	For u:= 2 to K div 2 do
 	If K mod U = 0 then T:=T+U;
 	UC:=T;
	End;
Function P(K:byte):Byte;
	Var T: Byte;
	Begin
	T:=0;
 	While K > 0 Do 
	Begin
 	T:= T + K mod 10;
 	K:= K div 10;
 	End;
 	 P:=T;
	End;
Procedure MangC;
	Begin
 	For i:=1 to n Do
 	For j:=1 to n do
 	C[i,j]:= P(A[i,j]) * UC(A[i,j]) + P(B[i,j]) * UC(B[i,j]);
	End;
Procedure TimMax ( X : MG ) ;
 	Var Max : Integer ;
 	Begin
 	For i:=1 to n do
 	Begin
 	For j:=1 to n do
 	If i=j then Max := X[1,1] ;
 	 For i := 2 to n do If Max < X[i,j] Then Max := X[i,j];
 	Writeln('Phan tu lon nhat la ', Max);
 	 End;
	End ;
Function NTCN(M,N: byte): Boolean;
	Begin
 	 While MN do
 	 If M>N then M:= M-N
 	else N:= N-M;
 	NTCN:=M=1;
	End;
Procedure TTDCP(X: MG);
	Var T: word;
	Begin
 	T:=0;
 	For i:=1 to N do
 	For j:=1 to N do
 	IF (i+j) > (n+1) then T:=T+X[i,j];
 Writeln('Tong cac phan tu phia duoi duong cheo phu = ',T);
	End;
Procedure TDCC(X: MG);
	Var T: word;
	Begin
 	T:=0;
 	For i:=1 to N do
 	For j:=1 to N do
 	IF i = j then T:=T+X[i,j];
 Writeln('Tong cac phan tu thuoc duong cheo chinh = ',T);
	End;
Procedure InKQ(X : MG; T : Char);
	Begin
 	Writeln('--------Day la mang ',T,'---------');
 	For i:=1 to N do
 	 Begin
 	For j:=1 to N do Write(X[i,j]:7);
 	Writeln;
 	 End;
 	Writeln('---->',X[1,1],' nguyen to cung nhau voi cac so nguyen sau: ');
 	For i:=2 to n do
 	For j:=2 to n do If NTCN(x[1,1], X[i,j]) then Write(X[i,j]:6);
 Writeln;
	End;
BEGIN
 	 Clrscr;
 	Nhap(A,'A'); Nhap(B,'B'); MangC;
 	 InKQ(A,'A'); Writeln; TimMax(A); TTDCP(A); TDCC(A);
 	 InKQ(B,'B'); Writeln; TimMax(B); TTDCP(B); TDCC(B);
 	InKq(C,'C'); TimMax(C); TTDCP(C); TDCC(C);
	Readln;
END.
---------------------------------------------------------------------------------
Bai 8 _ T103. 
Program bai8;
uses crt;
Var A: Array [1..20] of real;
	 N,i,j, m, t, d: byte; min, R,S,tg: real; TB: boolean;
BEGIN
 	Clrscr;
 	 Write('Nhap so phan tu cua mang = '); readln(m);
 	for i:= 1 to m do
 	begin
 	 	Write('A[', i , '] = '); readln(a[i]);
 	end;
 	for i:= 1 to m do
 	begin
 	Write(A[i]:7:2);
 	end;
 	Writeln;
 	Write('Nhap so nguyen = ') ; readln(N);
{--------a-------}
 	Write('Phan tu gan so nguyen ',N,' nhat la:');
 	S := abs(A[1] - N);
 	For i:= 1 to m do
 	If abs(a[i]-n)< S then S:=abs(a[i]-n);
 	For i:=1 to m do
If abs(a[i] - n) = S then Writeln('A[',i,']','=',A[i]:0:1);
{--------b-------}
 	Writeln;
 	Write('Nhap so thuc = ') ; readln(R);
 	i:=1; 
	Repeat
 	 IF a[i] = R then 
	begin 
	Writeln(R:0:1,' thuoc day so da cho'); Break; 
	end;
 	 i:=i+1;
 	Until i = m;
 If a[i]R then Writeln(R:0:1 ,'khong thuoc day da cho');
 	Writeln;
 	Write ('Nhap so can tim = ') ; readln(R);
 	d:=0;
 	For i:= 1 to m do
 	 If a[i]=R then d:=d + 1;
 Write('So cac so bang so can tim la: ', d); writeln ;
 	For i:=1 to m do 
	begin 
	F a[i]=R then Write('O vi tri',i:5); 
	end;
{----Day co tang (giam)------}
	{ i:=1;
	Repeat
 	 i:=i+1;
 	 IF a[i]< a[i-1] then
 	Begin
 	TB:= false;
 	Writeln('So la mat tinh tang la', a[i]:0:0)
 	end;
	Until i= n;
	If TB then Writeln('day la day tang')
	Else writeln('day khong phai la day tang dan');}
{---------}
	Writeln;
	i:=1;
	repeat
 	 i:= i+1;
 	if a[i] > a[i-1] then
 	begin
 	TB:=False;
 	Writeln('So lam mat tinh giam la',a[i]:0:0);
 	 End;
	Until i = n;
	If Tb then Writeln('Day la day giam dan')
	Else Writeln('Day khong phai la day giam');
{------e) phan tu lon hon tat ca cac phan tu truoc no---------------}
	Writeln ('cac so lon hon tat ca cac phan tu dung truoc no = ');
	min:=a[1]; i:= 2;
	Repeat
 	If a[i] > min then
 	Begin
 	Write(a[i]:7:0);
 	min:= a[i]
 	End;
 	i:= i+1;
	Until i=m+1;
{--------g) dua ra cac phan tu xuat hien trong day dung 1 lan-----}
	For i:= 1 to m-1 do
 	For j:= m-1 downto i do
 	if a[j] > a[j+1] then
 	Begin
 	 tg:=a[j];
 	a[j]:= a[j+1];
 	a[j+1]:=tg;
 	 end;
 	tg:=a[1]; d:=1;
 	For i:=2 to m do
 	 If a[i] = tg then d:= d+1
 	else begin 
	Writeln('so',tg:0:1,' xuat hien la :',d,' lan');
 	tg:=a[i]; d:=1; 
	 end;
 	Writeln('so',tg:0:1,' xuat hien la :',d,' lan');
	Readln
End. 
--------------------------------------------------------------------------------------
Bai10 _202 . {Viet chuong trinh cho may
a) Nhan vao motj xau X co khong it hon 9 ky tu so (Yeu cau kiem tra du lieu nhan vao)
b) Chuyen tat ca cac chu so le ve dau xau (khong lam thay doi thu tu truoc sau cua chung) khong dung xau trung gian, khong dung mang chi chen, xoa ngay tren xau}
Program Bai10;
uses Crt;
Var S: String; T, k,m, z:Integer;
Begin
 Clrscr;
 Write('Nhap vao xau S = ') ; Readln(s);
 Writeln(S);
 For k:= 1 to length(s) do
 	Begin
 	 If (S[k]='0') or (s[k] = '2')or (S[k]='4') or 
(s[k] = '6') or (s[k] = '8') then
 	Begin
 	Insert(S[k],S,length(s)+1);
 	 Delete(S,k,1);
 	 End;
 End;
 Write(S) ;
 Readln;
End.
---------------------------------------------------------
Bai 11_202. Cho xau n la nhung ki tu chu so. Xoa di k ki tu (K<n) de xau con lai co gia tri nho nhat.
Program Xau11
uses crt;
const N=20;
var 	S,tam,kq:string;
 a:array[1..N] of byte;
 	 i,j,k,min,T:byte;
 	 b:integer;
begin
 	clrscr;
 	randomize; S:='';
 	for i:=1 to N do
 	begin
 	 j:=random(9)+1;
 	str(j,tam);
 	 S:=s+tam;
 	 write(j:5);
 	end;
 	writeln;
 	writeln('S=',S);
 	write('Nhap k='); readln(k);
 	for i:=1 to N do
 	 begin
 	val(S[i],j,b);
 	a[i]:=j;
 	 end;
 	if k>length(s) then exit;
 	j:=1; kq:='';
 	 repeat
 	min:=a[j];
 	for i:=j+1 to k+length(kq)+1 do
 	if min>a[i] then
 	begin
 	j:=i; min:=a[i];
 	end;
 	j:=j+1;
 	str(min,tam);
 	kq:=kq+tam;
 	until length(kq)=length(s)-k;
 	writeln('Ket qua= ',kq);
 	readln;
end.
------------------------------------------------------------------------------
Bai12 _ T202. {Goi P la phep bien doi xau thay moi doan ki tu giong nhau boi chi 1 ki tu. VD: 'aaabbbcccaa'. P(s) = abca.
a) nhap vao mang A co n (n > 6) phan tu la nhung xau ki tu
b) Xay dung mang B co n phan tu , voi P[i] = P(a[i])}
c) In nh÷ng phÇn tö xuÊt hiÖn ®óng mét lÇn trong B.
Program bai12;
Uses crt;
Const n = 5;
type MG = array[1..n] of string;
Var S,d:string;
k : byte; A,B: MG;
Function P(T: byte): boolean;
 Var k, min: byte; Tb: boolean;
 Begin
	min:=0;
	T:= length(s);
	While min <= T do
	 Begin 
	TB:=true;
	min:=min+1;
	 Begin
 	For k:= 1 to T do
 	IF S[k] = s[k+1] then
 	 	begin 
	 	 delete(s,k+1,1) ; k:= k+1; break;
	 	end;
 	If TB = false then min:=k+1;
 	End;
 	 End;
 	 P:= TB;
 End;
BEGIN
 	Clrscr;
 	Write('Nhap vao xau s = '); readln(S);
 	Writeln(s); Write(length(s));
 	If P(length(S)) then Writeln(S);
 	Writeln('Nhap du lieu cho mang s ');
 	For k:=1 to n do
 	Begin Write('s[ ',k,' ]= '); readln(s[k]); end;
 	For k:= 1 to n do
 	begin
 	If P(length(S[k])) then Writeln('B[',k,']=',S[k]);
 	End;
---------------------------------------
Program BT6_207;
uses crt;
var n,m,i: integer; KT : boolean;
 Ng,T, C, DV, Tong : byte;
Begin
 Write('Nhap m= '); read(m); write(' n = '); readln(n);
 Writeln('So tu nhien be hon ',n,' ma co tong cac binh phuong cac chu so cua no bang ',m,' la: ');
 For i :=1 to n-1 do
 Begin
 Ng:=i div 1000;
 T:=(i mod 1000) div 100;
 C:= ((i mod 1000) mod 100)div 10;
 DV:= i mod 10;
 Tong:= (ng*ng + t*t + c*c + dv*dv);
 If (Tong = m) then
 Begin
 Write(i:5);
 KT:= true ;
 End;
 End;
 If not KT then writeln(' Khong co so nao thoa man');
 readln;
end.
--------------------------------------------------------------------------------------
VD 5: NhËp vµo mét x©u cã ®é dµi kh«ng qu¸ 50 kÝ tù, X¸c ®Þnh xem x©u võa nhËp cã chøa bao nhiªu kÝ tù dÊu c¸ch, xo¸ c¸c kÝ tù thø 2, 3, 4, 5.
program KTA3;
uses crt;
var s: string[50];
 j,dem: byte;
begin
 clrscr;
 writeln;
 write(' Nhap xau co do dai khong qua 50 ki tu: ');
 readln(s);
 dem :=0; {dem la so ki tu cach}
 for j:=1 to length(s) do
 if s[j]= ' ' then dem :=dem + 1;
 writeln(' So ki tu cach trong xau la: ',dem); {dua ra man hinh}
 delete(s,5,1); {xoa ki tu thu 5}
 delete(s,4,1); {xoa ki tu thu 4}
 delete(s,3,1); {xoa ki tu thu 3}
 delete(s,2,1); {xoa ki tu thu 2}
 writeln(' Xau s sau khi xoa: ',s);
 readln
end.
----------------------------------------------------------------------------------------
BT7_207. ViÕt ch­¬ng tr×nh cho m¸y nhËn vµo mét sè tù nhiªn n. Víi P(K) lµ sè ch÷ sè cña K. TÝnh P(1)/1 + P(2)/2 + ... + P(n)/n.
program BT7_207;
Uses crt;
Var n: word; k: byte;
Function P(K:word):Word;
Var T: byte;
 Begin
 T:=0;
 While k>0 do
 Begin
 T:=T+1;
 K:= K div 10;
 End;
 P:=T;
 End;
Procedure Tong;
Var T: real;
 begin
 T:=0;
 For k:= 1 to n do
 Begin
 T:= T + P(k)/k;
 End;
 Writeln('Tong can tim la: ',T:0:2);
 End;
BEGIN
 Clrscr;
 Write('nhap vao so tu nhien n = '); readln(n);
 Tong;
 Readln
END.
----------------------------------------------------------------------------------------
Bµi 8 _ T207.
Program bai8_207;
uses crt;
const n = 6;
var X: array [1..n] of string[4];
 S: array [1..n] of Integer;
 i,d,j: byte; m,z:integer;
Function dx(S:string): boolean;
 Var j: byte; kt:boolean;
 Begin
 KT:=true;
 For j:=1 to length(s) div 2 do
 IF S[j] S[length(s)-j +1] then
 begin
 KT:= False; break;
 end;
 IF S[j] = S[length(s)-j +1] then KT:= True;
 DX:= KT;
 End;
Function PT9(S: String): Boolean;
 var j: byte; kt: boolean;
 Begin
 Kt:=F