Ebook tự học lập trình pascal (tập 3) phần 2 bùi việt hà (chủ biên)

HUGNG DAN 137 Writeln‘Chuong trinh thay ky tu khác trống bằng "a":; WriteNhập một xau : ';Readinst;... Writeln' Chương trinh xử lý xâu có số :; WriteNhập một xâu có số : ;Readlnst; Repea

100 Lip hinds Patend - Ma (2d

Begin

Clrscr;

Writeln( Chương trinh tim một xảu con chung cực"

+dai cua hai xau:’):

Write(' Nhập xâu $1 : ');Readin($1):

Write’ Nhap xau 82 : ');Readin($2),

If (s1[=s2{j}) then Begin

k:=†:

While (i+k<=I1 )and(j+k<=I2) and

(S1fitk}=s2[j+k]) do inc(k):

If kmax<k then Begin kmax:=k; imax:=i;

102 Lip brink Pascal - Tip 3

Write(' Nhập xâu S1 : 9; Readin(s1);

Write(_ Nhập xâu S2 : 9; Readln(s2);

|1:Zlength(s1);

k:=0;

p:=pos(s1,$2);

While (p<>0) do Begin k:=ktp;

Phan 2 HUGNG DAN 103

Writeln(‘Chuang trinh tính số lần lặp của S1 trong S2:);

Wnfte( Nhập xâu S† : );Readln(s1):

Write( Nhập xâu S2 : ');Readin(s2);

I1:=lengfh(s1);

{2:=length(s2);

$:=0;

If (I2>=It) then For i:=1 to (I2-11+1)} do

104 La iw drat Pn wad - ‘Kin 3

Writeln(' Chương trình tinh số lần lặp rời nhau của'

+'S1 trong S2:

Write(’ Nhap xau S1 : ');Readln(s1),

Write(' Nhập xâu S2 ; );Readln(s2);

Write(ch); sii}:=sfij+ch;

End:

Until dem=N;, Writeln;

106 Lip tinh Pascal - Tap 3

Wnite(' Nhập độ dài N : ); Readin(N);

Writeln( Nhập 2 xâu nhị phân S1 và S2 : ),

For t:=1 to 2 do : Begin

dem:=0;

Write(’ Nhập xâu SỈ, : ), Repeat

ch:=readkey;

if ch in tap then Begin inc(dem); Wnte(ch);

S[Ï}=s[i]+ch, End;

Until dem=N;

Writeln;

End;

For i:=1 to ndo

If (s[2]fi] <> s[4]{i]} then

st:=s;

i+;

If (i<=9) then s:=s+1 Else if (i<=99) then s:=s+2 Else if (i<=999) then s:=s+3 Else if (i<=9999) then s:=s+4; End;

str(i,xi);

Write(copy(xi, 1,n-st));

Readin;

End

108 Lie toh: Pascal - ` ;

st:=s:

=i+Í;

if (i<=9) then s:=st+1 Else if (i<=99) then s:= s+2 Else if (i<=999) then s:= s+3 Else if (i<=9999) then s:= st4 Else if {i<=99999) then «.= s+5;

Writeln('Chương trinh viết xau dai 255 ki tu la phan’

+'đầu của xâu 1(100) :);

Write{ 4);

S;=1;

While (s<=n) do Begin

§C:=§; S:=§†3;

if (s<=255) then Write(st);

End;

Write(copy(st, 1,n-sc));

Writeln; Writeln(' Chương trình viết xâu dải 255 kí tự là phan’

+ 'đầu của xâu 10(001) :),

Write(10);

S:=2;

while (s<=n) do Begin

410 | Lig binh Pascal - Tap 3

20 A= 1(01)"0=1 0101 01 0

n lan 01 B= 0(10)"1 =0 1010 10 1

m lần 10

Để A là xâu con của B thì m>=n+1

§5 LENH LAP REPEAT

Phan 2 HUONG DAN 144

112 Lip tnads Pascai - ‘hin 3

Write(’ Nhap $6 thuc a: ‘};Readin(a):

Writelnj Các phần tử lớn a của dãy : );

hần 2 HƯỚNG DẪN 113

Begin

Clrscr,

Write(` Nhập độ dài của dãy số nguyên: );Readln(n);

Writeln(' Nhập các phần tử của dãy : );

For i:=1 to n do

Begin Write(‘ af',i,'] = ‘);ReadIn(ali));

if (afij= afj]) then trung:=true;

If not{trung} then write (all);

Begin

Clrscr;

Write(' Nhập độ dài của đây số nguyên: `:

114 Lép bint Pascal - Tip 3

End;

È=1;

Repeat trung:=false;

For j:=i+1 ton do {f (a[i]=alj]) then trung:=true;

lÍ trung then then Writeln(afi]:4);

Var thang: byte;

tien, lai, x: real;

Begin

Clrser;

Writeln(' Chương trình tính thời gian rút tiền lãi: '},

Write(' Số tiền lãi muốn rút ra :");Readln(X);

tien:=1000;

thang:=1;

repeat lai:=tien*8/100;

tien:=tlen+lai;

thang:=thang+1;

Until tien>=x;

Wnteln(' Bạn phải gti tién trong ', thang div 12,

‘nam’, thang mod 12," thang.’):

116 “âu J3 Pascal - ‘Vip 3

Writeln(' Khi đó số tiền bạn rút ra được là ',tien:12:2,' đồng );

Readln;

End

9 Program P3509;

Uses crt;

Var thang: byte:

tien, lai: real;

Write(‘S6 tha’ ="); Readin(ali])

End;

For i:=1 to n-1 do Repeat d.=a[i];

afi):=ali+1] mod ali);

117

118 Lép tinh Paseal - Tip 3

Write (Epxilon='); Readln(Epxilon);

Write (1/i > Epxilon); do

Begin S:= S+(1/i};

Writeln(’ Tim max clia mét dBy sO nguyén dé dai N:’);

Write(’ Nhap sé N :'); ReadIn(n);

Wrileln( Nhập các phần tử của dãy : ');

For i:=1 ton do Begin

Write(‘ a[‘i,'] = '); Readin(afi});

120 Lip hist Pasoad - ‘Tip 3

\f ajimax,jmax]<ali,j] then Begin

Phần 2 HƯỚNG DẪN 121

Until i>n;

Writeln(' Phần tử lớn nhất của mảng trên là a[',

imax,,,jmax,]= ` a[imax, jmarl);

122 Lap hink Pascal - 'lếp (3

Wrileln(' Phần tử lớn nhất trong ving tam gidc’

+ 'dưới đường chéo chính), Writeln(' của mảng trên là a[,imax, `,imax,] = ',

a[imax,jmax]); Readin;

Phan 2 HUGNG DAN 123

Max:=(N-i1)"J;

Pos:=' duoÏ;

End;

If Max<(j1-1)7i1 then Begin

Max:=(j1-1)*i1;

Pos.=' traf;

End;

If Max<(M-j1)*i4 then Begin

Max:=(M-j1)*i1;

Pos:=' phai;

End;

Write(‘Hinh chữ nhật lớn nhất của lưới khơng chứa +

“điểm (, ¡1 j1,)'+ nằm ở bên +Pos+' của điểm đĩ ')

Readln;

End

124 Lig bunt; Pascal - ‘lap ở

17 Program C3517;

Uses crt:

Var a: array [1 100,1 100] of integer,

m,n, S, smax, ai, aj, Di, bj: integer;

vitri: string;

Begin

Clrscr; ` Writeln(' Tìm miền chữ nhật lớn nhất không chứa'

+’(i,j) cla mat lưới ô vuông NxM :; Write(’ Nhap sé N : '); ReadIn(n);

Write(' Nhập số M: '); ReadIn(m);

Write(’ Nhap Ai: '); Readin(ai);

Write( Nhập Ai : ); Readln(a));

Write(' Nhập Bi: 3, ReadIn(bi);

Write(’ Nhap Bj: '); Readin(bj);

vitri:= tren xuong, giua;

End;

$:=(n-bi-1)*m;

if (s>smax) then Begin

Phan 2 HUGNG DAN 125

§maX:= S;

vitri:= tren;

s:=m '{ai-bi-1)

If (s>smax) then Begin smax:=s;

vitri:='fren xuong, giua End;

s:=(n-ai-1)*m;

it (s>smax) then Begin smax:=s;

vitri:=duof' End;

126 Lip brink Pascal - Tip 3

if (s>smax) then Begin

End;

End Else Begin s:=n*(bi-1);

smax'=S;

Vitri:='tral

$:=n*(aj-bj-1);

if (s>smax) then Begin smax:=s;

vitri:= ‘trai sang, giua’:

Ena;

$:=n*(m-aj-1);

if (s>smax) then Begin smax:=s; vitri:='phai’;

End;

End;

Phan 2 HUGNG DAN 127

Writeln(' Miền chữ nhật lớn nhất không chứa (¡j)}

'của luớởi 6 vuông |};

Writeln(' là miền chữ nhật", vitri,' À và B, có diện tích ',

428 Lép triads Pascal - “Tega ở

Phần 2 HƯỚNG DẪN 129

Writeln(' Nhập các phần tử của dãy : °,

For i:=1 tondo

Begin Wrie( a[,¡,]= );Readin(a[i);

Repeat k:=|+†;

130 Lip tink (aAn2l - Tip 3

Writeln(' Kiểm tra sự tốn tại của một cấp số cộng”

if p<>0 then Begin

132 Lip tink Pascal - Tip 3

Write( Nhập một xâu kí tự : );Readln(st),

While st[length(st}] = #32 do Delete(st, length(st),1);

Write(‘Nhap mét xau ky tu St : );Readln(st);

Write(‘Nhap gia tri Pos : );Readln(p);

Write(‘Nhap gia trị Size : );Readln(s);

sI1:=''; {xâu rỗng}

For i:=p to pts-1 do st1:=st1+st{[i];

Write(' Copy(St,', p,'’, s,') = ist);

134 Lip brink Pascal - ‘Tip 3

Writeln(' Thay thế "," đầu tiên bằng “!!" ; St1 = '\st4);

Wnteln(' Thay thé "***" bằng "*": S12 = ',sI2);

Readin, End

Writei::¡' Chương trình loại bỏ "abc" :);

Write( Nhập môt xâu 20 kỉ tự S† : );Readln(sÐ; SI1:=sÌ:

Repeal

|:=length(st1);

p:=pos( abc ,st1);

Phan 2 HUGNG DAN 137

Writeln(‘Chuong trinh thay ky tu khác trống bằng "a":);

Wri(te(Nhập một xau : ');Readin(st);

138 Lap Lush Pascal - ‘Vip 3

Writeln(' Chương trình loại bỏ dấu ngoặc ( ) : ;

Write( Nhập mội xâu : ); Readln(st);

Repeat

I:=length(s‡);

p1:=pos((.s});

lf (p1<>0) then Begin SI1:=copy(st,p1+1,-p1);

p2.=pf:

Repeat I1:=length(st1);

until (p1=0) or (p=0) or (p1>=p2);

Writeln(' Kết quả: 'ST);

Readin;

End

140 Lig hinh Pascal - Tig 3

For i:=(I div 2+1) tol do

If st{i]J="!" then stfi}:= “;

Writeln(' Chương trinh xử lý xâu có số :);

Write(Nhập một xâu có số : );Readln(st);

Repeat b:=otst{i);

142 Lig tinh Pascal - Tin 3

b) Néu Sic S2 va néu S2 lap trong S thi S1 cũng đã

lặp trong S Vậy TA(S1,S) >= TA(S2,S)

18 Đặt m= TAS(S1,S2) và n = TAS(S2,S) thì cứ mỗi

lần S2 lặp rời nhau trong S thi vì nó chứa m lần S2 nên $2

đã lặp rời nhau trong S m lần, Do đó:

Và 3<2.2 là bất đẳng thức ngược lại

20 Program P3620;

Uses crt;

Const hoa: set of char=ƑA' Z];

dau: set of char=[ ',:,!'?];

Var st: string;

I, i, j: byte:

Begin

Cirser;

Writeln(‘Chuang trinh stta 1di chinh ta :’);

Wriie(Nhập một xâu : '};Readin(st);

I:=length(st);

Phần 2 HƯỚNG DẪN 143

Wnie(i<=L) and (stfi] = #32) do inc(i);

If i<=L then sifil:=upcase(stfi));

While(i<=L) and not (st{i] in dau) do inc(Ì);

End;

Wnte(Phần tử cần thêm vào cuối dãy số đã cho là: ');

144 Lip buinh Pascal ~ Teg 3

For i:=N downto k+1 do Afi]:=Afi-1}:

Write(Số phân tử của dãy số Á là p=);ReadIn(p);

Writeln(Nhập các phần tử của dãy số}

For t:=1 to pdo

Begin Write(A[,¡,]E);ReadIn(A[i);

End;

Write(‘S6 phan tử của dãy số B.là q=);Readln(q); Writeln(Nhập các phần tử của dãy số);

For i:=1 to q do Begin Write(‘Bf’ i, =');Readin(B{i]);

Tg:=CỊ], C[:=CII, CHI=tg;

End:

Writein(‘In day C sau khida sắp xếp);

For i:=1 to ptq do Write(Cfi}:8:2);

Write(‘Nhan Enter dé két thuc ’);

Readln;

End

146 — Lap binh Pascal ~ Tap 3

Writeln(Nhập 2 xâu nhị phân S1 va S2’);

Write(Độ dài N=); Readin(N), For i:=1 to 2 do

Begin dem:=0;

Write(‘Nhap xau S’,i,"="):

Repeat ch:=readkey;

if ch in tap then

Begin inc(dem);

148 Lap tink Pascal - Tag 3

k:=me-md+1;

_ For ï:=md to me do case s[1]{i} of '0:s[1]Il:=1;

Writeln( Kiểm tra hai xâu nhị phân độ dai N cho’

+ trước có phải là k tương đương không : *;

Write(Nhập độ dài N : ');Readln{N);

Writeln( Nhập 2 xâu nhị phân S1 và 52: `);

For i:=1 to 2 do Begin dem:=0;

Write(’ Nhap xau S$’, : 9;

Repeat ch:=readkey;

if ch in tap then Begin

450 Lp tinh Pascal - Tig 3

lf s{1]<>s[2] then Wiite(Hai xâu s† và s2 không +

'phải là ,k,tương đương)

Else Wnte(Hai xáu s† và s2 là ',k,' tương đương ); Readin;

152 Lap tink Paseal - Tip 3

Writeln(Số lần đọc còn lại là ',dem,' lan);

Writeln(Bạn đã đọc được tất cả:', dem-1,' lan'); (Đọc số NJ

Repeat Write(.); Readln(W);

if N<=0 then Writeln(#7'Ban phai doc s6 tu nhién>0’); Until n>0;

kt:=false:

n†:=true;

{Kiểm tra tính nguyên tố của xố N}

{Néu N ld nguyén tố thì nt=true, von tai thi nt = false}

case N of 1: nt=false:

2.3: nt=true Else

Begin

nt:=true;

For i:=2 to {N div 2) do

if (N mod i=0) then nt:=false;

End:

{ Case }

Phần 2 HƯỚNG DAN 453

If not (nt) then { Néu N không nguyên rố }

Begin

if k=0 then Begin

k:=1;

sodadoc{1]:=N,

End Else { if K<>0 }

If k>=1 then Begin inc(k);

For i:=1 to k-1 do

If N<>sodadocii| then sodadoc|k}:=N

(Số N chưa được đọc}

Else kl:=truUe; {Số N đã được đọc rồi }

If kt=true then dec(dem) Else

Begin can:=sqrt(N);

154 Lip bink Pascal - Tip 3

Until N>O;

If k=O then Begin

sodadoc[k]:=N;{Kién tru xem xố N vừa đọc có

nguyên tố cùng nhau với các số đã đọc hay không}

If N<>1 then Begin kt:=true;

If kt=true then ine{solan)

Else {Kiém tra xem số N vừa đọc có chưng từ 2 ước xố trở lên với Í trong những xố đã đọc không}

If min<b then min:=b;

dem:=1; {Đếm xố ước xố chung của a và h} For j:=2 to min do

If (a mod j=0) and (b mod j=0) then inc(dem);

Until (i=k-1)or(dem>=2);

156 Lip tinh Pasoal - Tips 3

Until (solan=0); {Hé ror do}

Writeln( Bạn đã hết lượt chơi');

Write(' Nhãn Enter để kết thúc”);

Readin:

End

11 Lần 1: Người nông dân chở Dé qua sông

Lần 2: Người nông dân chở Sói qua sông, lượt về chở

Dê về cùng

Lần 3: Người nông dân chở Bắp cải qua sông

Lần 4: Người nông dân chở nốt Dê qua sông

(a*1000+b”100+c*10+d) then Writeln(a,b,c,d);

Write('Nhấn Enter để thoat ’);

Readln;

End.

Phan 2 HUGNG DAN 157

k:=2;

while (k<=(N1 dụw 2))and(T<=10000) do Begin

158 Lip tinh Pascal - Tip 3

For z:=1 to 9 do

if x=z then Begin Write(x, y,2,#32#32);

Begin

Clrscr;

Phan 2 HUGNG DAN 159

Writeln(Các số N<100 thỏa mãn điều kiện binh’

+ 'phương của N là số Palindrom là');

For i:=1 to 100 do

Begin bp:=sqr();

str(bp,S);

If length(s}=1 then = Writeln(i) Else

Begin k:=length(s) div 2;

kti=true;

For j:=1 to k do

lf s[j]<>s[lengfh(s)-j+1] then kt:=false;

lf kt=true then Writeln(I):

160 Lip tinh Paseal ~ Tap 3

Writeln('Các số N<1000 thỏa mãn điều kiện N vài

+ "binh phương của N là số Palindrom là);

if (length(sbp)=1) then kt:=true Else if (sbp(1}=sbp[2]) then kt:=true;

End Else

Begin kts:=true;

for |:=1 to (length(s) div 2) do {f s{j]<>s[length(s)-j+1] then kts:=false:

ktbp:=true;

For j:=1 to (length(sbp) div 2) do

if sop[j]<>sbp[length(sbp)-j+1] then ktbp:=false;

If kts and ktbp then kt:=true;

End;

If kt then Begin Writeln{i}; inc(D):

End;

End:

Repeat KT:=true;

str(N,S);

k:=(length(s)+1) div 2;

For i:=1 tok do

If s[i]<>sf{length(s)-i+ 1] then kt:=false;

If kt=true then Write(‘S6 N là sd Palindrom’} Else

162 Lip tink Pascal - Tig 3

Begin

If c=O then Writeln(Các phép biến đổi

+ sau đưa số 'N,` thành Palindrom));

a

inc(count); ’ For i:=1 to k do Begin ch:=s[i];

If (count<=100) and (kt=true) then

Write(‘Can ’ count, lần biển đổi để đưa',M,

‘thanh số Palindrom là ',ÑN) Else Write(Phép biến đổi chưa đạt kết quả sau’,

count, ‘ian bién đổi);

Readhn;

End

18 Program P3718;

Uses crt;

Narmsinh array[1 MaxHS] of longint;

Noisinh: array{[1 MaxHS] of string[40];

continue:=readkey;

End;

Clrscr;

164 Lip bink Pascal - Tap 3

Writein(‘In ra nhGng hoc sinh 06 Ho ta Nguyén’);

For i:=1 to sohs do

Write(' Số phần tử của dãy số:);Readln(N);

Writeln('Nhập các phần tử của dãy số);

End

20 Program P3720;

Uses crt;

Const Max=100;

166 Lip bink Pascal - Tip ~

Var A:array[1 Max] of real;

DN i:byte;

kt1 ,kt2:boolean;

Begin {Main Program}

Cirscr;

Write('Số phần tử của dãy số:); Readln(N);

Writeln(Nhập các phần tử của dãy số);

For i:=1 to N do

Begin Write(‘Af.i,J=';Readin(Afi]);

End;

D.=1;

kt1:=A[1]>=Al2Ì:

For i:=2 to N-1 do Begin

Kt2:=A{iJ>=A(i+1];

If Kt2<>Kt1 then Begin inc(D);

21 Lần1: Địa chủ 1 cùng người hầu của mình qua sông

Người hầu quay về,

Lần 2: Địa chủ 2 cùng người hầu của mình qua sông

Địa chú † quay về