2. Двумерные массивы
Дана квадратная матрица.
Произвести транспонирование (переворот) матрицы относительно ее главной диагонали
program p1;
const N=4;
var
A:array[1..N,1..N] of real;
I,J,B:integer;
begin
WRITELN('vvod massiva');
FOR I:=1 TO N DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
FOR I:=1 TO N DO
FOR J:=1 TO N DO
IF I<J THEN
BEGIN
B:=A[I,J];
A[I,J]:=A[J,I];
A[J,I]:=B;
END;
WRITELN('vIvod massiva');
FOR I:=1 TO N DO
BEGIN
FOR J:=1 TO N DO
WRITE(A[I,J],' ');
WRITELN;
END;
readln;
readln;
end.
Дана квадратная матрица.
Произвести переворот матрицы относительно ее побочной диагонали
program p2;
const N=4;
var
A:array[1..N,1..N] of real;
I,J,B:integer;
begin
WRITELN('vvod massiva');
FOR I:=1 TO N DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
FOR I:=1 TO N DO
FOR J:=1 TO N DO
IF I+J<N+1 THEN
BEGIN
B:=A[I,J];
A[I,J]:=A[N+1-J,N+1-I];
A[N+1-J,N+1-I]:=B;
END;
WRITELN('vIvod massiva');
FOR I:=1 TO N DO
BEGIN
FOR J:=1 TO N DO
WRITE(A[I,J],' ');
WRITELN;
END;
readln;
readln;
end.
Дана квадратная матрица.
Произвести инвертирование (переворот) элементов нечетных строк
program p3;
const N=4;
var
A:array[1..N,1..N] of real;
I,J,B:integer;
begin
WRITELN('vvod massiva');
FOR I:=1 TO N DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
FOR I:=1 TO N DO
IF I MOD 2 <>0 THEN
FOR J:=1 TO N DIV 2 DO
BEGIN
B:=A[I,J];
A[I,J]:=A[I,N-J+1];
A[I,N-J+1]:=B;
END;
WRITELN('vIvod massiva');
FOR I:=1 TO N DO
BEGIN
FOR J:=1 TO N DO
WRITE(A[I,J],' ');
WRITELN;
END;
readln;
readln;
end.
Дана квадратная матрица.
Найти произведение элементов, кратных семи и
расположенных на соседних двух диагоналях, параллельных главной
program p4;
const N=4;
var
A:array[1..N,1..N] of INTEGER;
I,J,P:integer;
begin
WRITELN('vvod massiva');
FOR I:=1 TO N DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
P:=1;
FOR I:=1 TO N DO
FOR J:=1 TO N DO
IF (ABS(I-J)=1) AND (A[I,J] MOD 7 = 0) THEN
P:=P*A[I,J];
WRITELN('vIvod P');
WRITE(P);
readln;
readln;
end.
Дана квадратная матрица.
Найти максимальное значение среди элементов, расположенных ниже побочной диагонали
program p5;
const N=4;
var
A:array[1..N,1..N] of INTEGER;
I,J,max:integer;
begin
WRITELN('vvod massiva');
FOR I:=1 TO N DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
max:=A[N,N];
FOR I:=1 TO N DO
FOR J:=1 TO N DO
IF (I+J>N+1) AND (A[I,J] >MAX) THEN
MAX:=A[I,J];
WRITELN('vIvod MAX');
WRITE(MAX);
readln;
readln;
end.
Дана квадратная матрица.
Найти минимальное значение среди элементов, расположенных выше главной диагонали
program p6;
const N=4;
var
A:array[1..N,1..N] of INTEGER;
I,J,MIN:integer;
begin
WRITELN('vvod massiva');
FOR I:=1 TO N DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
mIN:=A[1,1];
FOR I:=1 TO N DO
FOR J:=1 TO N DO
IF (J>I) AND (A[I,J] <MIN) THEN
MIN:=A[I,J];
WRITELN('vIvod MIN');
WRITE(MIN);
readln;
readln;
end.
Дана квадратная матрица.
Найти максимальное значение среди ее элементов,
расположенных: в первой и последней строках, первом и последнем столбцах,
на главной и побочной диагоналях
program p7;
const N=5;
var
A:array[1..N,1..N] of INTEGER;
I,J,MAX:integer;
begin
WRITELN('vvod massiva');
FOR I:=1 TO N DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
mAX:=A[1,1];
FOR I:=1 TO N DO
FOR J:=1 TO N DO
IF (I=1) OR (I=N) OR (J=1) OR (J=N) OR (I=J) OR (I+J=N+1) THEN
IF A[I,J]>MAX THEN
MAX:=A[I,J];
WRITELN('vIvod MAX');
WRITE(MAX);
readln;
readln;
end.
Дана прямоугольная матрица.
Вычислить среднее арифметическое значение среди ее элементов,
расположенных в четных строках и нечетных столбцах.
program p8;
const m=4;n=5;
var
A:array[1..m,1..N] of real;
I,J,K:integer;
S,SR:REAL;
begin
WRITELN('vvod massiva');
FOR I:=1 TO M DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
S:=0; K:=0;
FOR I:=1 TO N DO
FOR J:=1 TO N DO
IF (I MOD 2 = 0) AND (J MOD 2 <> 0) THEN
BEGIN
S:=S+A[I,J];
K:=K+1;
END;
IF K=0 THEN
WRITELN('TAKIX HET')
ELSE
BEGIN
SR:=S/K;
WRITELN('vIvod SR');
WRITE(SR);
END;
readln;
readln;
end.
Дана прямоугольная матрица.
Поменять местами строки, содержащие наибольший
и наименьший элементы матрицы (все элементы матрицы различны)
program p9;
const m=4;n=5;
var
A:array[1..m,1..N] of real;
I,J,MAX,MIN,IMAX,IMIN:integer;
B:REAL;
begin
WRITELN('vvod massiva');
FOR I:=1 TO M DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
MAX:=A[1,1]; IMAX:=1;
MIN:=A[1,1]; IMIN:=1;
FOR I:=1 TO M DO
FOR J:=1 TO N DO
BEGIN
IF A[I,J]>MAX THEN
BEGIN
MAX:=A[I,J];
IMAX:=I;
END;
IF A[I,J]<MIN THEN
BEGIN
MIN:=A[I,J];
IMIN:=I;
END;
END;
FOR J:=1 TO N
BEGIN
B:=A[IMAX,J];
A[IMAX,J:=A[IMIN,J];
A[IMIN,J]:=B;
END;
WRITELN('vIvod MASSIVA');
FOR I:=1 TO M DO
BEGIN
FOR J:=1 TO N DO
WRITE(A[I,J],' ');
WRITELN;
END;
readln;
readln;
end.
Дана прямоугольная матрица.
Найти количество столбцов, в которых все элементы положительные
program p10;
const m=4;n=5;
var
A:array[1..m,1..N] of INTEGER;
I,J,K,F:integer;
begin
WRITELN('vvod massiva');
FOR I:=1 TO M DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
K:=0;
FOR J:=1 TO N DO
BEGIN
F:=0;
FOR I:=1 TO M DO
IF A[I,J]<= 0 THEN F:=1;
IF F=0 THEN
K:=K+1;
END;
WRITELN('vIvod K');
WRITE(K);
readln;
readln;
end.
Дана прямоугольная матрица.
Построить вектор B, где B[i] - число неотрицательных элементов в i-ой строке.
program p11;
const m=4;n=5;
var
A:array[1..m,1..N] of INTEGER;
B:ARRAY[1..M] OF INTEGER;
I,J,K:integer;
begin
WRITELN('vvod massiva');
FOR I:=1 TO M DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
FOR I:=1 TO M DO
BEGIN
K:=0;
FOR J:=1 TO N DO
IF A[I,J]>= 0 THEN K:=K+1;
B[I]:=K;
END;
WRITELN('vIvod MASSIVA B');
FOR I:=1 TO M DO
WRITELN(B[I]);
readln;
readln;
end.
Дана прямоугольная матрица.
Построить вектор B, где B[i] - число нулевых элементов в i-ом столбце
program p12;
const m=4;n=5;
var
A:array[1..M,1..N] of INTEGER;
B:ARRAY[1..N] OF INTEGER;
I,J,K:integer;
begin
WRITELN('vvod massiva');
FOR I:=1 TO M DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
FOR J:=1 TO N DO
BEGIN
K:=0;
FOR I:=1 TO M DO
IF A[I,J]= 0 THEN K:=K+1;
B[J]:=K;
END;
WRITELN('vIvod MASSIVA B');
FOR I:=1 TO N DO
WRITELN(B[I]);
readln;
readln;
end.
Дана прямоугольная матрица.
Построить вектор B, где B[i] - среднее арифметическое
отрицательных элементов в i-ой строке (если отрицательных элементов нет, то B[i]=0).
program p13;
const m=4;n=5;
var
A:array[1..m,1..N] of REAL;
B:ARRAY[1..M] OF REAL;
I,J,K:integer;
S:REAL;
begin
WRITELN('vvod massiva');
FOR I:=1 TO M DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
FOR I:=1 TO M DO
BEGIN
K:=0;S:=0;
FOR J:=1 TO N DO
IF A[I,J]< 0 THEN
BEGIN
K:=K+1;
S:=S+A[I,J];
END;
IF K=0 THEN
B[I]:=0
ELSE
B[I]:=S/K;
END;
WRITELN('vIvod MASSIVA B');
FOR I:=1 TO M DO
WRITELN(B[I]);
readln;
readln;
end.
Дана прямоугольная матрица.
Построить вектор B, где B[i] - максимальное значение в i-ом столбце.
program p14;
const m=4;n=5;
var
A:array[1..m,1..N] of REAL;
B:ARRAY[1..N] OF REAL;
I,J:integer;
MAX:REAL;
begin
WRITELN('vvod massiva');
FOR I:=1 TO M DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
FOR J:=1 TO N DO
BEGIN
MAX:=A[1,J];
FOR I:=1 TO M DO
IF A[I,J]>MAX THEN
MAX:=A[I,J];
B[J]:=MAX;
END;
WRITELN('vIvod MASSIVA B');
FOR I:=1 TO N DO
WRITELN(B[I]);
readln;
readln;
end.
Дана прямоугольная матрица.
Построить вектор B, где B[i] - номер максимального значения в i-ой строке.
program p15;
const m=4;n=5;
var
A:array[1..m,1..N] of REAL;
B:ARRAY[1..M] OF INTEGER;
I,J,JMAX:integer;
MAX:REAL;
begin
WRITELN('vvod massiva');
FOR I:=1 TO M DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
FOR I:=1 TO M DO
BEGIN
MAX:=A[I,1]; JMAX:=1;
FOR J:=1 TO N DO
IF A[I,J]>MAX THEN
BEGIN
MAX:=A[I,J];
JMAX:=J;
END;
B[I]:=JMAX;
END;
WRITELN('vIvod MASSIVA B');
FOR I:=1 TO M DO
WRITELN(B[I]);
readln;
readln;
end.
Дана прямоугольная матрица.
Построить вектор B, где B[i] - число элементов i-ого столбца,
значения которых равно заданному значению
program p16;
const m=4;n=5;
var
A:array[1..m,1..N] of INTEGER;
B:ARRAY[1..N] OF INTEGER;
I,J,K,Z:integer;
begin
WRITELN('vvod massiva');
FOR I:=1 TO M DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
WRITELN('vvod Z');
WRITE(Z);
FOR J:=1 TO N DO
BEGIN
K:=0;
FOR I:=1 TO M DO
IF A[I,J]=Z THEN
K:=K+1;
B[J]:=K;
END;
WRITELN('vIvod MASSIVA B');
FOR I:=1 TO N DO
WRITELN(B[I]);
readln;
readln;
end.
Дана прямоугольная матрица.
Построить вектор B, где B[i] - равно 1,
если значения элементов i-ой строки упорядочены
по возрастанию, в противном случае 0
program p17;
const m=4;n=5;
var
A:array[1..m,1..N] of INTEGER;
B:ARRAY[1..M] OF INTEGER;
I,J,F:integer;
begin
WRITELN('vvod massiva');
FOR I:=1 TO M DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
FOR I:=1 TO M DO
BEGIN
F:=0;
FOR J:=1 TO N-1 DO
IF A[I,J+1]<=A[I,J] THEN
F:=1;
IF F=0 THEN
B[I]:=1
ELSE
B[I]:=0;
END;
WRITELN('vIvod MASSIVA B');
FOR I:=1 TO M DO
WRITELN(B[I]);
readln;
readln;
end.
Дана прямоугольная матрица.
Построить вектор B, где B[i] - номера строк последних
минимальных элементов в i-ом столбце
program p18;
const m=4;n=5;
var
A:array[1..m,1..N] of INTEGER;
B:ARRAY[1..N] OF INTEGER;
I,J,MIN,IMIN:integer;
begin
WRITELN('vvod massiva');
FOR I:=1 TO M DO
BEGIN
FOR J:=1 TO N DO
read(A[I,J]);
WRITELN;
END;
FOR J:=1 TO N DO
BEGIN
MIN:=A[M,J]; IMIN:=M;
FOR I:=M DOWNTO 1 DO
IF A[I,J]< MIN THEN
BEGIN
MIN:=A[I,J];
IMIN:=I;
END;
WRITELN('vIvod MASSIVA B');
FOR I:=1 TO M DO
WRITELN(B[I]);
readln;
readln;
end.
Задачи на слова.
Проверить является ли введенное слово симметричным (палиндромом).
program p1;
var
a:string;
f,i,n:integer;
begin
read(a);n:=length(a);
f:=0;
For i:=1 to n div 2 do
if a[i]<>a[n-i+1] then
f:=1;
if f=0 then
writeln('yes')
else
writeln('no');
readln;readln;
end.
Перевернуть введенное слово
program p2;
var
a:string;
i,n:integer;
b:char;
begin
read(a);n:=length(a);
For i:=1 to n div 2 do
begin
b:= a[i];
a[i]:=a[n-i+1];
a[n-i+1]:=b;
end;
writeln(a);
readln;readln;
end.
Заменить во введенном слове первую букву “a” на “o”
program p3;
var
a:string;
i,n,f:integer;
begin
read(a);n:=length(a);
f:=0;
For i:=1 to n do
if a[i]='a' then
begin
a[i]:='o';
f:=1;
break;
end;
if f=1 then
writeln(a)
else
writeln('net bykvi a');
readln;readln;
end.
Заменить во введенном слове последнюю букву “a” на “o”
program p4;
var
a:string;
i,n,f:integer;
begin
read(a);n:=length(a);
f:=0;
For i:=n downto 1 do
if a[i]='a' then
begin
a[i]:='o';
f:=1;
break;
end;
if f=1 then
writeln(a)
else
writeln('net bykvi a');
readln;readln;
end.
Дано слово. Если оно четной длины, то удалить символы, стоящие на четных позициях, иначе оставить слово без изменения.
program p5;
var
a:string;
i,n:integer;
begin
read(a);n:=length(a);
if n mod 2=0 then
begin
i:=2;
while i<=n do
begin
delete(a,i,1);
i:=i+1;
end;
end;
writeln(a);
readln;readln;
end.
Определить есть ли во введенном слове хотя бы два одинаковых символа
program p6;
var
a:string;
i,j,n,f:integer;
begin
read(a);n:=length(a);
f:=0;
for i:=1 to n do
for j:=1 to n do
if (a[i]=a[j]) and (i<>j) then
f:=1;
if f=0 then
writeln('no')
else writeln('yes');
readln;readln;
end.
Определить сколько повторений имеет каждый символ во введенном слове.
program p7;
var
a,b:string;
i,j,n,k,f:integer;
c:array[1..50] of integer;
begin
read(a);n:=length(a);
b:='';f:=0;
for i:=1 to n do
if pos(a[i],b)=0 then
begin
k:=0;
for j:=i+1 to n do
if a[i]=a[j] then
k:=k+1;
f:=f+1;
b:=b+a[i];
c[f]:=k;
end;
if f>0 then
for i:=1 to f do
writeln(b[i],' - ',c[i],' pobtoreni')
else
writeln('slovo ne vveli');
readln;readln;
end.
Дано слово. Если оно четной длины, то удалить 2-ю половину слова, а первую половину перевернуть.
Если слово нечетной длины, то удалить средний символ
program p8;
var
a:string;
b:char;
i,n,k:integer;
begin
read(a);n:=length(a);
k:=n div 2;
if n mod 2=0 then
begin
delete(a,k+1,k);
for i:=1 to k div 2 do
begin
b:=a[i];
a[i]:=a[k-i+1];
a[k-i+1]:=b;
end;
end
else
delete(a,k+1,1);
writeln(a);
readln;readln;
end.