Lý thuyết và bài tập Pascal phần III

{Bai 3.9}
program B3_9;
uses crt;
var i, n: integer;
's: longint;
begin

clrscr,
'write(Nhap so n:');

readIn(n);

'writeln(n, ' phan tu dau tien cua tap A:');

s:=0;
for Ì := 1ton do

begin

sis2*s+1;
'writeln(So thu ', i, "', S);

end;

readin;
end.

{Bai 3.10}
program p3_10;

uses crt;

const max = 100;
var
a, duong, am, nguyento, hopso: array [1..max] of integer;
i,j

k, m,n, p, q: integer;

ngto: boolean;
begin

€lrscr;
{nhap n so}
'Write(Nhap so n:);
readin(n);

fori:=1tondo

91


begin

write('So thu ', ¡
readlIn(a[i);

end;
{dem}

m:=0; { so so duong}
0; { so so am}

0; { so so nguyen to }

{ so hop so}

fori:

1tondo

begin
if ali] < 0 then { so am }
begin
k;=k+1;

amfk] := ali;

end;

if afi] > 0 then
begin

m:=m+*1;
duong[m] :=

ngto := true;

Li]:

forj := 2 to trunc(sqrt(a[i])) do

if ali] modj = 0 then { hop so}

begin

ngto := false;

q:=q*1;

hopso[q] := a[i];

break;
end;
if (ngto) and (a[i] > 1) then { nguyen to }
begin

p:=p+1;
nguyento[p] := afi];

end;

end;
end;
92


{viet ket qua }
{ so duong }
ifm> 0then

begin

'writeln('Co ', m, ' so duong);

forï := 1 tom do

writeln('So duong thụ

i, ": ', duong[i]);

end
else
writeln('Khong co so duong nao’);
{soam}

ifk > 0 then
begin
'writeln(Co ', k, ' so am);

for i:= † to k do

_writeln('So am thu ', i r1 ami]);

end
else

'writeln(Khong co so am nao’);
{ so nguyen to }
ifp > 0 then
begin
'writeln('Co ', p, ' so nguyen to);
fori:=1topdo

'writeln('So nguyen to thu ', í, ': ', nguyento[i]);

end

else
writein(‘Khong co so nguyen to nao’);

{hop so}
ifq> 0 then
| begin

'writeln(Co ', q, ' hop so’);
for ¡ := 1 to q do
writeln(‘Hop so thu ',

end

„ hopso[i]);

else
93


writein(Khong co hop so nao’);
readin;
end.

{Bai 3.11}
uses cit;

const nmax = 32000,

type mang = array [1..nmax] of Integer,

var

ni: integer;
a:mang;

ketthuc : boolean;
{: text,

Procedure inketqua(k:integer);
var j: integer,
begin
for j:=1

to k do write(f,alj}:5);

writeln(f);

end;

Procedure sinhmoi(K:integer);

thu tu lon hon
{Xay dung mot tong khac co
tang dan}
thoa man : cac so hang cua tong

var j,i,tg : integer,
begin

i

while (aJ]<2) and (J>0)
or (a[j-1]+2 > a[j])

do dec();

ifj< 2 then

begin ketthuc:=true;exit end;

a[j]=aU}-1:

alj-1]=all-1]+1;
ifj
94


lo k-1 do a[i]=a[-1];
1 1o k-1 do tg:=tg+al];

Procedure phantich(k:integer;n:integer);
{Phan tịch n thanh tong cua k so}
Var j : integer,
begin

if (k>n) or (k<=0) then exit;
for j:=1 to k-1 do a[Ï}
a[K}=n-k+1;
ketthuc:=false;

while not ketthuc do
begin

inketqua(k);

sinhmoi(k); { sinh cach phan tich moi}

end;
end;
Begin

repeat

clrscr,

'write('Nhap So n (>0) :

');

until n > 0;
assign(f,'Ketqua.
txt);
rewrite(f);

for i:= n downto 4 do phantich(i,n);

{phantich(4,19);}
close(f);
write(Ket qua trong file Ketqua.txt, an Enter de thoat.");

readin;
End.


(Bai 3.12}
program p3_12;

uses crt,
const

mang: array[1..5] of real = (1.0, 2

op :array[1..4] of char
var
i

.0, 4.0, 5.0, 6.0);

= (+"

: integer,

a,b,c,

n,t

d: integer,

:real,

dien
begin

:boolean,
.

clrser,
write(Nhap so n:');

readin(n);
dien := false;

1to4do

forb:=
for c:=

11o4 do

1 to 4 do
to4do

case a of

:t;= mang[1] + mang[2];
mang[1] - mang[2],

:= mang[1] “ mang[2],
end;

case b of

+ mang[3]:
~ mang[3];

* mang[3]:

=
end;

case c Of
96

t/ mang[3]:

"


_

+ mang[4],

4:t:=t/
end;
case d of

- mang[4];
* mang[4];
mang[4];,

1:t:=t + mang[5];

2:
†- mang[5];
3: t:=t* mang[5];
4:

†/ mang[5];

end;
ifn=tthen
begin

dien := true;

writeln(n = ', '(((1'. op[a], '2}, op[b], 4), op[c]. '5)', op[d], '6);

end;
end;

if not dien then

writeln(‘Khong the dien’);

readin;

end.

{Bai 3.13}
uses crt;
const nmax = 50;

type
var

ma_tran = array [1..nmax, 1..nmax] of integer;
a,b : ma_tran;
n,i,j : byte;

Procedure Nhap_mt(var a : ma_tran;var n : byte);
var i,j : byte; x,y : integer;

begin

_ fepeat

7-BTLT

97


clrscr,

'write(nhap so phan tu cua ma tran (<=50) :');

read(n);

until (n>0) and (n<51);
writeln(Nhap cac phan tu cua ma tran ?);
y:=whereY;

for ï:=1 to n do
begin

x:=2iinc(y);

for j:=1 ton do
begin

X:=x+5;
GotoXY(x,y);

end;

read(a[ijj);

end;
end;

Procedure Matrancon(i,j,n:byte;a:ma_tran;var c:ma_tran);

var p,q: byte;

begin
for p:=1 to i-1 do
begin

for q:=1 to j-1 do c[p,q]:=a[p.d];

for q:=j+1 to n do c[p,q-1):=a[p,q]:
end;
for p:=i+1 to n do.
begin
for q:=1 to j-1 do c[p-1.q]:=a[p,q]:
for q;=j+1 to n do c[p-1,q-1]:=alp,q];

end;

end;
Procedure In_matran(n:byte;a : ma_tran);
var i,j:byte;
begin

98


writeln;
for i:=1 ton do
begin
for j:=1 to n do
'write(a[ij]:8);

'writeln;
end;

end;

BEGIN
Nhap_mt(a,n);
writeln(‘Nhap chi so dong va chỉ so cot can bo.);
'write('Dong : ');readin(i);

write('Cot : ');readIn();
Matrancon(i,j,n,a,b);
In_matran(n-1,b);

readin;
END.

(Bai 3.14}
uses crt;
const nmax = 50;

type

ma_tran = array [1..nmax,1..nmax] of integer;

var

a:ma_tran;
n,ij,k : byte;
tg : integer;

f,f1,f2,f3 : boolean;
Procedure Nhap_mt(var a : ma_tran;var n : byte);

var ij: byte;

begin

repeat
clrser;
'write(nhap so phan tu cua ma tran (<=50) : );

99


read(n);

until (n>0) and (n<51);
to n do

:=1

{co the nhap ket qua:

read(a[lj):

end;

a[ji:=2-a[ijl:

Ì

end;

end;
Procedure In_matran(n:byte;a

var i,j:byte;

: ma_tran);

begin

'writeln;
for ï:=1 ton do
begin
for j:=1 to n do

write(alij]:8);

'writeln;

end;
end,
Begin
Nhap_mt(a,n);
in_matran(n,a);

¡f2:=false;f3:=false,

f

for i:=1 ton do

begin

tg:=0;

Ie;{gia su doi i khong thua}
i}
;=0;{k la so tran thang cua doi

100


for j:=1 ton do

begin
tg:=tg+alij];
ïf (alij]E0) and (<>j)
then f:=false;(doi ¡ da thua}
if afi,jJ=2 then ine(k);

end;

if tg>n-1 then
begin

if not f1 then

begin

'Writeln(Cac doi co so tran thang nhieu hon thua ok

f1:=true
end;

writein(‘doi' i:4,".’;
end;

if f then

begin

if not 2 then

begin

'writeln(Cac doi khong thua tran nao :’);

f2:=true;

end;
writeln(‘Doi ‘i:4,'.');

end;
if 2*k>n*(n-1) then
begin

if not f3 then
begin
writeln('Doi co so tran thang nhieu hon nua so tran dau:

f3:=true;

end;
writeln(‘doi',i:4,".');

end;
end;
if not f3 then
101


writeln(‘Khong co doi nao thang nhieu hon nua tong so tran dau.,

readin,
End.
{Bai 3.15}
program p3_15;
uses crt;

const max = 20;

var

n, m, i, j: integer;

1, 12, t: integer;

: array[1..max] of integer;,

a,b _
begin

€lrscr;

{ nhap n so}

'write(Nhap so n:);
readin(n);

fori:=1tondo

begin

write(So thu ', i, `

readIn(a[i]);

end;
{xoa cac so 0}

b:=

a; { sao luu mang
a}

m:=n;
while i <= m do
begin

if bf] = 0 then
begin

forj:=itom-1do

bill :=

bi+1];


eit;

end;
writeln(Day sau khi xoa cac so 0:');

for ï := 1 to m do
writeln(b[i]);

{xoa
cac so < 0}

b:= a; { sao luu mầng a }

m:=n;
i=;

while i <= m do

begin
if b{i] < 0 then
begin
for

j:=itom-1do

bị] := b[j+1];

m:=m-1,

end;
writeln(‘Day sau khi xoa cac so < 0:);
for
¡ :=,1 to
m do

writeln(b[i]);
{xoa cac so nam trong khoang l1, I2}
b:=a; { sao luu mang a }

I=1;
'Write('Nhap so l1:

readIn(l1);

Write(Nhap so l2: ');
readIn(I2);

if 1 > 12 then
begin

t=l1;

108

end;
while i <= m do

begin
if (b{i) >= 11) and (b[i] <= 12) then
begin
for j:=itom-1do
BỊ] :=

b[j+1];

m:=m-1;

-4;

end;
l#+1;
end;
writeln(Day sau khi xoa cac so nam trong khoang ', I1, ' va",
for¡ := 1 to m do.

writeln(b[f]);

readin;
end

{Bai 3.16}
uses crt;
var

ij: integer;

a,b,c : array [1..100,1..100] of integer;
n,m:

integer;

thay : boolean;
max,min : array [1..100] of integer;

Begin
clrscr,
write ( Nhap vao so hang vua ma tran : ');
readin(n);
write ('‘ Nhap vao so cot cua ma tran : ');
readIn(m);

=

104

1ton do

l2, ');


begin
write (‘af'i,',')j,]
readln(a[i,j]);

for i=

end;

1 ton do

begin

min[i= a[i,1];
for j;= 1 to m do
if min[i| > a[ij] then min[i| := a[ij];

end;
for ï:= 1 ton do

for j= 1 tom do

if a[ij] = mini] then bfi,]

for j:= 1 to m do

begin
max[j] := a[1,]]
for

tondo

if max[j] < afi,j] then max{[i] := a[i,j];

end;

for j:= 1 tomdo
for i:= 1 tondo
if a[i,j] = max{j] then cfi,j) :

writeln(’ MA TRAN BAN DAU’);
for ï:= 1ton do
begin
'writeln;

for j:= 1 tom do
write('', afi),

end;
writeln;

for i:= 1†on do
begin
'writeln;

for j:= 1tom do
write('", b[ij],");

end;
105


writeln;

for i:= 1 ton do

begin

writeln;
forj= 1 tom do

write(’', c[i,j),");
end;
writeln;
for i= 1 ton do
for j:= 1 to m do

if (cfij] = 1) and (bfi,j] = 1) then

begin
writeln (' Diem yen ngua cua ma tran la : a['j,1j,]);
writeln (' Gia tri tai diem yen ngua la : ‘,ali,j]);
thay := true;

end;
if thay = false then write (‘ MA TRAN KO CO DIEM YEN NGUA'’);
readin;

end.

{Bai 3.17}
Uses crt,
const nmax = 50;

Type matran = array[1..nmax,1..nmax+1] of real;

mang = array [1..nmax+1] of real,

Var

a: matran;

nị : byte;
x: mang;

Procedure Nhapmt(var a : matran;var n

var i,j: byte; xy : integer;
begin
repeat

clrser,

106

: byte);


write(‘nhap so an cua phuong trinh (<=50) : ');

read(n);

until (n>0) and (n<51);
'writelnNhap cac phan tu cua ma tran he so (du) :');
y:=whereY;

for Ï;=1 to n do
begin

GotoXY(x,y);

end;
end;

read(a[ij]);

end;
function Khuheso(var a : matran;n : byte) : boolean;

Var i,j,k : byte;

max,tg : real;

am

:boolean;

Begin

for i:=1 to n do.

begin

{chon he so max cua cot ¡
trong cac dong can khu : tu ¡ den n}

ma:

:

for k:=i

to n do.

if max < abs(a[k,i]) then
begin
max := abs(a|k,i));
if a[k,i]<0 then am:=true else am:=false;

end;

if max = 0 then
{neu tat ca cac he so can khu cot i = 0}

107


begin {phuong trinh vo no hoac vo so no}
khuheso:=false;
exit; { thoat }

end;

{doi dong j cho dong i}
for k:=i to n+1 do

end;

{chia dong i cho max : }

if am then max:=-max;

for k:=i to n+1 do a[i,k]:=ali,k]/max;
for j:=i+1 ton do

begin

tg:=a[ii]:

for k:=i to n+1 do
afj,k]-tg*ali,k];

i,

end;
khuheso:=true'

end;
Procedure timnghiem(a:matran,n:byte;Var x : mang);
i,j: byte; tg : real;

Var

Begin

for i:= n-1 downto 1 do

begin

tg := 0,
for

j:=i+1 to n do tg:=tg+alij]*xf]:

x[i]:=a[in+1}†g;

end;

End;

108


BEGIN
nhapmt(a,n);

if not khuheso(a,n) then

Writeln(Phuong trinh co vo nghiem.))

else begin
timnghiem(a,n,x);
'Writeln(Bo nghiem cua phuong trình la : ');

for i:=1 to n do writeln(x[i]:8:8);
end;

write(‘an Esc de thoa);

repeat until readkey=#27;
END.
{Bai 3.18}

uses crt;
var
ij: integer;
n,m: integer;

a,b,c : array [1..100,1..100] of integer;
Begin
Clrscr,
'write(' Nhap vao so hang cua 2 ma tran : ');

readin (n);
'write(' Nhap vao so cot cua 2 ma tran : ');
readin(m);

for i= 1 ton do
for

j;= 1tomdo
begin

write ( a['Ì j1:
readin(ali,j));

end;

for i:= 1 tondo
for j := 1 tom do
begin

write (t b[,
109


readIn(b[iij]):
end;
writeln (‘MA TRAN A’),
for i:= 1 tondo

begin

for

tomdo

write ("', ail" )i

writeln,
end;

writeln ( ' MA TRAN B);
for i:= 1 tondo
begin
for j:= 1 tom do

write (*', bli)" )s

writeln;
end;
for i;= 1ton do
for

tom do

fi) = ali) + bE).

writeln(' MA TRAN A+B);
for i= 1 ton do

begin

for j:= 1 tom do

write ("', efi)" );

writeln;
end;
readin;
End.

{Bai 3.19}
uses

crt;

var

ij; integer,
n,m: integer;

abc: array [1..100,1..100] of integer;
110