Книга программиста/Обработка матриц на PascalABC.Net
К оглавлению | Назад | Вперёд
Все программы, код которых выложен здесь, являются работоспособными. На момент написания программ использовалась среда PascalABC.Net 3.0 (и 3.3).
Простые задачи
[править]Максимальные элементы столбцов матрицы
[править]const
N = 3;
M = 3;
var
A: array [0..N - 1, 0..M - 1] of integer;
Max: array [0..M - 1] of integer;
begin
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
A[i, j] := Random(10);
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to M - 1 do
Write(A[i, j]:3);
Writeln();
end;
for var j := 0 to M - 1 do
begin
Max[j] := integer.MinValue;
for var i := 0 to N - 1 do
if A[i, j] > Max[j] then Max[j] := A[i, j];
end;
Writeln('Максимумы:');
for var j := 0 to M - 1 do
Write(Max[j]:3);
end.
begin
Print(MatrRandom(3, 3, 0, 10).Cols().Select(x -> x.Max()));
end.
Смотрите также: реализация на C#.
Смотрите также: реализация на VB.
Количество двузначных чисел с четной суммой цифр
[править]Формула, по которой можно узнать сумму цифр двузначного числа: n div 10 + n mod 10.
const
N = 3;
M = 3;
var
A: array [0..N - 1, 0..M - 1] of integer;
C: integer;
procedure Print(); // Производит вывод матрицы.
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to M - 1 do
Write(A[i, j]:3);
Writeln();
end;
end;
begin
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
A[i, j] := Random(100);
Print();
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
if (Abs(A[i, j]) >= 10) and (Abs(A[i, j]) < 100) and ((A[i, j] div 10 + A[i, j] mod 10) mod 2 = 0) then
Inc(C);
WritelnFormat('Количество двузначных чисел с четной суммой цифр равно {0}.', C);
end.
Смотрите также: реализация на С#.
Смотрите также: реализация на VB.
Наибольший по модулю элемент матрицы
[править]const
N = 3;
M = 3;
var
A: array [0..N - 1, 0..M - 1] of integer;
Max, MaxI, MaxJ: integer;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to M - 1 do
Write(A[i, j]:3);
Writeln();
end;
end;
begin
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
A[i, j] := -10 + Random(20);
Print();
Max := 0;
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
if Abs(A[i, j]) > Max then
begin
Max := Abs(A[i, j]);
MaxI := i; MaxJ := j;
end;
WritelnFormat('Наибольший по модулю элемент матрицы с индексами [{0}, {1}] равен {2}.', MaxI, MaxJ, Max);
end.
Смотрите также: реализация на C#.
Смотрите также: реализация на VB.
Поменять местами строки матрицы
[править]const
N = 3;
M = 3;
var
A: array [0..N - 1, 0..M - 1] of integer;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to M - 1 do
Write(A[i, j]:3);
Writeln();
end;
end;
begin
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
A[i, j] := Random(10);
Print();
var i1 := Random(N);
var i2 := Random(N);
for var j := 0 to M - 1 do
Swap(A[i1, j], A[i2, j]);
Print();
end.
Смотрите также: реализация на C#.
Произведение элементов матрицы
[править]const
N = 3;
M = 3;
var
A: array [0..N - 1, 0..M - 1] of integer;
Mult: integer;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to M - 1 do
Write(A[i, j]:3);
Writeln();
end;
end;
begin
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
A[i, j] := 1 + Random(10);
Print();
Mult := 1;
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
Mult *= A[i, j];
WritelnFormat('Произведение элементов матрицы равно {0}.', Mult);
end.
Узнать, сколько раз встречается данное число в матрице
[править]const
N = 3;
M = 3;
var
A: array [0..N - 1, 0..M - 1] of integer;
C, K: integer;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to M - 1 do
Write(A[i, j]:3);
Writeln();
end;
end;
begin
Readln(K);
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
A[i, j] := Random(10);
Print();
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
if A[i, j] = K then
Inc(C);
WritelnFormat('Количество чисел, равных K, равно {0}.', C);
end.
Смотрите также: реализация на C#.
Запись матрицы в список по столбцам
[править]begin
var A := MatrRandom();
var L := new List<integer>();
for var j := 0 to Length(A, 1) - 1 do
for var i := 0 to Length(A, 0) - 1 do
L.Add(A[i, j]);
L.ToArray().Println();
end.
Количество единиц в столбце, равное номеру столбца
[править]begin
var A := MatrFill(ReadlnInteger(), ReadlnInteger(), 0);
for var j := 0 to Length(A, 1) - 1 do
for var i := 0 to j do
A[i, j] := 1;
A.Println();
end.
4 варианта заполнения матрицы по треугольникам
[править]const
N = 10;
var
A: array [0..N - 1, 0..N - 1] of char;
begin
for var i := 0 to N - 1 do
for var j := 0 to N - 1 do
if (i > j) and (N - i - 1 > j) then
A[i, j] := '+'
else
A[i, j] := '.';
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(A[i, j]);
Writeln();
end;
end.
const
N = 10;
var
A: array [0..N - 1, 0..N - 1] of char;
begin
for var i := 0 to N - 1 do
for var j := 0 to N - 1 do
if (i < j) and (N - i - 1 > j) then
A[i, j] := '+'
else
A[i, j] := '.';
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(A[i, j]);
Writeln();
end;
end.
const
N = 10;
var
A: array [0..N - 1, 0..N - 1] of char;
begin
for var i := 0 to N - 1 do
for var j := 0 to N - 1 do
if (i < j) and (N - i - 1 < j) then
A[i, j] := '+'
else
A[i, j] := '.';
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(A[i, j]);
Writeln();
end;
end.
const
N = 10;
var
A: array [0..N - 1, 0..N - 1] of char;
begin
for var i := 0 to N - 1 do
for var j := 0 to N - 1 do
if (i > j) and (N - i - 1 < j) then
A[i, j] := '+'
else
A[i, j] := '.';
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(A[i, j]);
Writeln();
end;
end.
Арифметические прогрессии в строках матрицы
[править]const
N = 3;
M = 3;
var
A: array [0..N - 1, 0..M - 1] of integer;
IsProgression: boolean;
begin
for var i := 0 to N - 1 do
begin
WritelnFormat('Ввод {0}-ой строки:', i + 1);
for var j := 0 to M - 1 do
Readln(A[i, j]);
end;
IsProgression := true;
if M > 2 then
for var i := 0 to N - 1 do
begin
var D := A[i, 1] - A[i, 0];
for var j := 2 to M - 1 do
if A[i, j] - A[i, j - 1] <> D then
begin
IsProgression := false;
break;
end;
if not IsProgression then break;
end;
if IsProgression then
Writeln('Каждая строка матрицы является арифметической прогрессией.')
else
Writeln('Существует несколько или одна строк, которые не являются арифметическими прогрессиями.');
end.
Средняя сложность
[править]Удаление строк с нулями
[править]const
N = 4;
M = 5;
var
A: array [0..N - 1, 0..M - 1] of integer;
Size: integer;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to Size - 1 do
begin
for var j := 0 to M - 1 do
Write(A[i, j]:3);
Writeln();
end;
end;
function HasZeros(i: integer): boolean; // Возвращает true, если i-ая строка матрицы имеет нули.
begin
Result := false;
var j := 0;
while (j < M) and not Result do
begin
if A[i, j] = 0 then Result := true;
Inc(j);
end;
end;
procedure RemoveStr(n: integer); // Удаляет i-ую строку матрицы.
begin
if Size > 0 then
begin
for var i := n to Size - 2 do
for var j := 0 to M - 1 do
A[i, j] := A[i + 1, j];
for var j := 0 to M - 1 do
A[Size - 1, j] := -1;
Dec(Size);
end;
end;
begin
Size := N;
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
A[i, j] := Random(10);
Print();
var i := 0;
while i < Size do
if HasZeros(i) then
RemoveStr(i)
else
Inc(i);
Print();
end.
Суммирование элементов строки до последнего отрицательного
[править]Суммировать положительные элементы строки до последнего отрицательного и записать в список. Если отрицательных чисел в строке нет - записать в список 0.
begin
var Matrix := MatrRandom(5, 5, -10, 10).Print();
var R := Matrix.Rows().ToArray();
var L := new List<integer>;
for var i := 0 to R.Length - 1 do
if not R[i].Any(x -> x < 0) then
L.Add(0)
else
begin
var row := R[i].ToArray();
L.Add(row.Where((x, index) -> (x > 0) and (index < row.FindLastIndex(x -> x < 0))).Sum());
end;
L.Println();
end.
Количество отрицательных элементов под главной диагональю
[править]const
N = 4;
var
A: array [0..N - 1, 0..N - 1] of integer;
C: integer;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(A[i, j]:3);
Writeln();
end;
end;
begin
for var i := 0 to N - 1 do
for var j := 0 to N - 1 do
A[i, j] := Random(10) - 3;
Print();
for var i := 0 to N - 1 do
for var j := 0 to N - 1 do
if (i > j) and (A[i, j] < 0) then
Inc(C);
WritelnFormat('Количество отрицательных элементов под главной диагональю матрицы равно {0}.', C);
end.
Смотрите также: реализация на C#.
Смотрите также: реализация на VB.
Минимальные элементы на пересечении строк и столбцов
[править]const
N = 3;
M = 3;
var
A: array [0..N - 1, 0..M - 1] of integer;
Min, MinI, MinJ: integer;
Found: boolean;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to M - 1 do
Write(A[i, j]:3);
Writeln();
end;
end;
begin
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
A[i, j] := Random(100);
Print();
for var i := 0 to N - 1 do
begin
Min := integer.MaxValue;
Found := true;
for var j := 0 to M - 1 do
if A[i, j] < Min then
begin
Min := A[i, j];
MinI := i;
MinJ := j;
end;
for var i2 := 0 to N - 1 do
if A[i2, MinJ] < Min then
Found := false;
if Found then break;
end;
if not Found then
Writeln('Минимального элемента на пересечении строк и столбцов не найдено.')
else
WritelnFormat('Индексы минимального элемента {0} равны [{1}, {2}].', Min, MinI, MinJ);
end.
Смотрите также: реализация на C#.
Максимальный элемент диагонали
[править]const
N = 3;
var
A: array [0..N - 1, 0..N - 1] of integer;
Max: integer;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(A[i, j]:3);
Writeln();
end;
end;
begin
for var i := 0 to N - 1 do
for var j := 0 to N - 1 do
A[i, j] := Random(10);
Print();
Max := integer.MinValue;
for var i := 0 to N - 1 do
if A[i, i] > Max then
Max := A[i, i];
WritelnFormat('Максимальный элемент диагонали равен {0}.', Max);
end.
Последний элемент строки матрицы - сумма всех элементов в той же строке матрицы
[править]const
N = 3;
M = 3;
var
A: array [0..N - 1, 0..M - 1] of integer;
i, j: integer;
S: integer;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to M - 1 do
Write(A[i, j]:5);
Writeln();
end;
end;
begin
for i := 0 to N - 1 do
for j := 0 to M - 1 do
A[i, j] := Random(10);
Print();
for i := 0 to N - 1 do
begin
S := 0;
for j := 0 to M - 2 do
Inc(S, A[i, j]);
A[i, j + 1] := S;
end;
Print();
end.
Заполнение матрицы одним циклом
[править]const
N = 5;
var
A: array [0..N - 1, 0..N - 1] of integer;
procedure Print(d: integer);
begin
for var i := 0 to Pred(N) do
begin
for var j := 0 to Pred(N) do
Write(A[i, j]:d);
Writeln();
end;
Writeln();
end;
begin
for var i := 0 to Pred(Sqr(N)) do
A[i div N, i mod N] := i;
Print(4);
end.
Сложные задачи
[править]Переворот главной диагонали
[править]const
N = 4;
var
A: array [0..N - 1, 0..N - 1] of integer;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(A[i, j]:3);
Writeln();
end;
end;
begin
for var i := 0 to N - 1 do
for var j := 0 to N - 1 do
A[i, j] := Random(10);
Print();
for var i := 0 to N div 2 - 1 do
Swap(A[i, i], A[N - i - 1, N - i - 1]);
Print();
Readln();
end.
Переворот побочной диагонали
[править]const
N = 4;
var
A: array [0..N - 1, 0..N - 1] of integer;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(A[i, j]:3);
Writeln();
end;
end;
begin
for var i := 0 to N - 1 do
for var j := 0 to N - 1 do
A[i, j] := Random(10);
Print();
for var i := 0 to N div 2 - 1 do
Swap(A[i, N - i - 1], A[N - i - 1, i]);
Print();
end.
Произведение ненулевых диагональных элементов
[править]const
N = 4;
var
A: array [0..N - 1, 0..N - 1] of integer;
M: integer;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(A[i, j]:3);
Writeln();
end;
end;
begin
for var i := 0 to N - 1 do
for var j := 0 to N - 1 do
A[i, j] := Random(4);
Print();
M := 1;
for var i := 0 to N - 1 do
if (A[i, i] <> 0) and (i <> N div 2) then
M *= A[i, i];
for var i := 0 to N - 1 do
if A[i, N - i - 1] <> 0 then
M *= A[i, N - i - 1];
WritelnFormat('Произведение ненулевых элементов равно {0}.', M);
end.
Заполнение матрицы по правилу
[править]Вариант 1
[править]1 | 0 | 2 | 0 | 3 |
0 | 4 | 0 | 5 | 0 |
6 | 0 | 7 | 0 | 8 |
const
N = 4;
M = 7;
var
A: array [0..N - 1, 0..M - 1] of integer;
V: integer;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(A[i, j]:5);
Writeln();
end;
end;
begin
for var i := 0 to Pred(N) do
begin
for var j := 0 to Pred(M) do
if (i + j) mod 2 = 0 then
begin
Inc(V);
A[i, j] := V;
end;
end;
Print();
end.
Вариант 2
[править]Правило заполнения:
1 | 2 | 3 | 4 | 5 |
2 | 1 | 2 | 3 | 4 |
3 | 2 | 1 | 2 | 3 |
4 | 3 | 2 | 1 | 2 |
5 | 4 | 3 | 2 | 1 |
const
N = 5;
var
A: array [0..N - 1, 0..N - 1] of integer;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(A[i, j]:5);
Writeln();
end;
end;
begin
for var d := -N + 1 to N - 1 do
for var j := 0 to N - 1 do
begin
var i := j + d;
if (i >= 0) and (i < N) then
A[i, j] := Abs(d) + 1;
end;
Print();
end.
Смотрите также: реализация на C#.
Смотрите также: реализация на VB.
i := j + d можно рассматривать как функцию, где вместо f(x) пишется i, а вместо правой части выражения - j + d.
Вариант 3
[править]1 | 2 | 3 | 4 |
8 | 7 | 6 | 5 |
9 | 10 | 11 | 12 |
16 | 15 | 14 | 13 |
const
N = 5;
var
A: array [0..N - 1, 0..N - 1] of real;
Value: integer := Sqr(N);
procedure Print(d: integer);
begin
for var i := 0 to Pred(N) do
begin
for var j := 0 to Pred(N) do
Write(A[i, j]:d);
Writeln();
end;
Writeln();
end;
begin
if N mod 2 = 0 then
for var i := Pred(N) downto 0 do
for var j := 0 to Pred(N) do
begin
var f := i mod 2 <> 0;
A[i, Ord(f) * j + Ord(not f) * (Pred(N) - j)] := Value;
Dec(Value);
end
else
for var i := Pred(N) downto 0 do
for var j := 0 to Pred(N) do
begin
var f := i mod 2 = 0;
A[i, Ord(f) * j + Ord(not f) * (Pred(N) - j)] := Value;
Dec(Value);
end;
Print(3);
end.
Заполнение матрицы по спирали
[править]const
N = 10;
var
A: array [0..N - 1, 0..N - 1] of integer;
i, j: integer;
Count: integer;
Value: integer;
procedure Print();
begin
for var i1 := 0 to N - 1 do
begin
for var j1 := 0 to N - 1 do
Write(A[i1, j1]:6);
Writeln();
end;
end;
begin
repeat
var b := Pred(N) - Count;
while j <= b do
begin
A[i, j] := Value;
Inc(j);Inc(Value);
end;
Inc(i);Dec(j);
while i <= b do
begin
A[i, j] := Value;
Inc(i);Inc(Value);
end;
Dec(i);Dec(j);
while j >= Count do
begin
A[i, j] := Value;
Dec(j);Inc(Value);
end;
Dec(i);Inc(j);Inc(Count);
while i >= Count do
begin
A[i, j] := Value;
Dec(i);Inc(Value);
end;
Inc(i);Inc(j);
until Count > N div 2;
Print();
end.
Транспонирование матрицы
[править]Пример транспонирования матрицы:
-1 | 2 | 4 | 0 | 7 |
3 | -5 | 24 | 9 | -3 |
-10 | -8 | -2 | -4 | 1 |
преобразовать в:
-1 | 3 | -10 |
2 | -5 | -8 |
4 | 24 | -2 |
0 | 9 | -4 |
7 | -3 | 11 |
const
N = 3;
M = 1;
var
MatrixA, MatrixB: array [,] of integer;
procedure Print(a: array [,] of integer);
begin
Writeln('Матрица:');
for var i := 0 to Length(a, 0) - 1 do
begin
for var j := 0 to Length(a, 1) - 1 do
Write(a[i, j]:3);
Writeln();
end;
end;
begin
SetLength(MatrixA, N, M);
SetLength(MatrixB, M, N);
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
MatrixA[i, j] := Random(10);
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
MatrixB[j, i] := MatrixA[i, j];
Print(MatrixA);
Print(MatrixB);
end.
Сортировка столбцов матрицы по первой строке
[править]const
N = 4;
M = 7;
type
TData = auto class
Key, Index: integer;
end;
var
A: array [0..N - 1, 0..M - 1] of integer;
Outcome: array [0..N - 1, 0..M - 1] of integer;
DataArray: array [0..M - 1] of TData;
procedure Print();
begin
Writeln('Матрица:');
for var i := 0 to N - 1 do
begin
for var j := 0 to M - 1 do
Write(Outcome[i, j]:3);
Writeln();
end;
end;
procedure Sort(l, r: integer);
begin
var i := l;
var j := r;
var m := DataArray[Round((l + r) / 2)].Key;
repeat
while DataArray[i].Key < m do Inc(i);
while DataArray[j].Key > m do Dec(j);
if i <= j then
begin
Swap(DataArray[i], DataArray[j]);
Inc(i);
Dec(j);
end;
if l < j then Sort(l, j);
if i < r then Sort(i, r);
until i > j;
end;
begin
for var i := 0 to N - 1 do
for var j := 0 to M - 1 do
A[i, j] := Random(10);
for var j := 0 to M - 1 do
DataArray[j] := new TData(A[0, j], j);
Sort(0, M - 1);
for var j := 0 to M - 1 do
for var i := 0 to N - 1 do
Outcome[i, j] := A[i, DataArray[j].Index];
Print();
end.
Узоры на матрицах
[править]Математика индексов матрицы - теория.
Бабочка
[править]const
N = 10;
var
A: array [0..N - 1, 0..N - 1] of char;
begin
for var i := 0 to N - 1 do
for var j := 0 to N - 1 do
if (i <= N - j - 1) or (i <= j) then
A[i, j] := '+'
else
A[i, j] := '.';
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(A[i, j]:2);
Writeln();
end;
end.
Песочные часы
[править]const
N = 9;
var
A: array [0..N - 1, 0..N - 1] of char;
begin
for var i := 0 to N - 1 do
for var j := 0 to N - 1 do
if (i <= N - j - 1) and (i <= j) or (i >= N - j - 1) and (i >= j) then
A[i, j] := '+'
else
A[i, j] := '.';
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(A[i, j]:2);
Writeln();
end;
end.
Заполнение диагоналей матрицы по правилу
[править]0 | 1 | 2 | 3 | 4 |
0 | 0 | 1 | 2 | 3 |
0 | 0 | 0 | 1 | 2 |
0 | 0 | 0 | 0 | 1 |
0 | 0 | 0 | 0 | 0 |
const
N = 10;
var
A: array [0..N - 1, 0..N - 1] of integer;
K: integer;
begin
K := 1;
for var D := 1 to N - 1 do
begin
for var i := 0 to N - 1 do
for var j := 0 to N - 1 do
if i <= j - D then
A[i, j] := K;
Inc(K);
end;
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(A[i, j]:5);
Writeln();
end;
end.