Ошибка с заменой компонент матрицы
Помогите с исправлением ошибки в подпрограмме procedure substitution_meaning_massif;
Код:
Program zadanie;
Uses crt;
const
digits=1;
Type matrix = Array [1..10, 1..10] of real;
massiv = Array [1..100] of Integer;
Var m: matrix;
tmp, max:real;
v: massiv;
s,imax,n,k: Integer;
procedure input_matrix;
var n,k,i,j,a,b,p1,p2: Integer;
begin
Write ('Введите количество строк матрицы n');
WriteLN (' не менее 2 и не более 10');
ReadLN (n);
If (n<2) Or (n>10) Then
Begin
Write ('Вы ввели неправильное количество строк меньше 2 или');
Write (' больше 10, поэтому принят');
WriteLN (' максимальный размер, т.е. n=10');
n:=10;
End;
Write ('Введите количество столбцов матрицы k');
WriteLN (' не менее 2 и не более 10');
ReadLN (k);
If (k<2) Or (k>10) Then
Begin
Write ('Вы ввели неправильное количество столбцов меньше 2 или');
Write (' больше 10, поэтому принят');
WriteLN (' максимальный размер, т.е. k=10');
k:=10;
End;
Write ('Введите левую а и правую b границы диапазона');
WriteLN (' значений компонент матрицы');
Write ('a='); ReadLN (a);
Write ('b='); ReadLN (b);
If a>b Then
Begin
p1:=a; a:=b; b:=p1;
End;
If a=b Then
Begin
p1:=0; p2:=b;
End
Else
If b=0 Then
Begin
p1:=a; p2:=0;
End
Else
Begin
p1:=b-a; p2:=a;
End;
Randomize;
For j:=1 To k Do
begin For i:=1 To n Do
Begin
m[i,j]:=p2+random(p1+1);
end;
end;
end;
procedure output_matrix;
var i,j,n ,k: integer;
begin
writeln ('Исходная матрица');
For i:=1 To n Do
begin
For j:=1 To k Do
begin Write (m[i,j]:6:digits) end;
write(' ');
writeln;
end;
End;
procedure seach_abs_max;
var i,j,n ,k: integer;
begin
imax:=1;
max :=m[i,j];
for i:=1 to N do
begin for j:=1 to k do
begin if max<abs(m[i,j]) then
begin
max:=abs(m[i,j]);
imax:=i;
imax:=j;
end;
end;
end;
writeln('Максимальное абсолютное значение: max=',max:5:digits);
end;
procedure seach_quantum_abs_max;
var i,j,n ,k: integer;
begin
For i:=1 to n do
For j:=1 to k do
If abs(m[i,j])=max then
begin s:=s+1 end;
Writeln('Количество совпадений max= ',s);
end;
procedure substitution_meaning_massif;
var i,j,n ,k: integer;
begin
write('Одномерный массив');
if ((i+j) mod 2)=0 then
begin v[s]:=1 end
else
begin v[s]:=-1 end;
For i:=1 to s do
begin write(v[i]:3)
end;
end;
procedure output_regenerate_matrix;
var i,j,n ,k: integer;
begin
Writeln;
Write('Измененная матрица');
for i:= 1 to n do
begin
tmp:= m[1,i];
m[1,i]:= m[n,i];
m[n,i]:= tmp;
end;
for i:= 1 to n do
begin
writeln;
for j:= 1 to k do
begin write(m[i,j]:6:digits) end;
end;
end;
begin
input_matrix;
output_matrix;
seach_abs_max;
seach_quantum_abs_max;
substitution_meaning_massif;
output_regenerate_matrix;
END.
Uses crt;
const
digits=1;
Type matrix = Array [1..10, 1..10] of real;
massiv = Array [1..100] of Integer;
Var m: matrix;
tmp, max:real;
v: massiv;
s,imax,n,k: Integer;
procedure input_matrix;
var n,k,i,j,a,b,p1,p2: Integer;
begin
Write ('Введите количество строк матрицы n');
WriteLN (' не менее 2 и не более 10');
ReadLN (n);
If (n<2) Or (n>10) Then
Begin
Write ('Вы ввели неправильное количество строк меньше 2 или');
Write (' больше 10, поэтому принят');
WriteLN (' максимальный размер, т.е. n=10');
n:=10;
End;
Write ('Введите количество столбцов матрицы k');
WriteLN (' не менее 2 и не более 10');
ReadLN (k);
If (k<2) Or (k>10) Then
Begin
Write ('Вы ввели неправильное количество столбцов меньше 2 или');
Write (' больше 10, поэтому принят');
WriteLN (' максимальный размер, т.е. k=10');
k:=10;
End;
Write ('Введите левую а и правую b границы диапазона');
WriteLN (' значений компонент матрицы');
Write ('a='); ReadLN (a);
Write ('b='); ReadLN (b);
If a>b Then
Begin
p1:=a; a:=b; b:=p1;
End;
If a=b Then
Begin
p1:=0; p2:=b;
End
Else
If b=0 Then
Begin
p1:=a; p2:=0;
End
Else
Begin
p1:=b-a; p2:=a;
End;
Randomize;
For j:=1 To k Do
begin For i:=1 To n Do
Begin
m[i,j]:=p2+random(p1+1);
end;
end;
end;
procedure output_matrix;
var i,j,n ,k: integer;
begin
writeln ('Исходная матрица');
For i:=1 To n Do
begin
For j:=1 To k Do
begin Write (m[i,j]:6:digits) end;
write(' ');
writeln;
end;
End;
procedure seach_abs_max;
var i,j,n ,k: integer;
begin
imax:=1;
max :=m[i,j];
for i:=1 to N do
begin for j:=1 to k do
begin if max<abs(m[i,j]) then
begin
max:=abs(m[i,j]);
imax:=i;
imax:=j;
end;
end;
end;
writeln('Максимальное абсолютное значение: max=',max:5:digits);
end;
procedure seach_quantum_abs_max;
var i,j,n ,k: integer;
begin
For i:=1 to n do
For j:=1 to k do
If abs(m[i,j])=max then
begin s:=s+1 end;
Writeln('Количество совпадений max= ',s);
end;
procedure substitution_meaning_massif;
var i,j,n ,k: integer;
begin
write('Одномерный массив');
if ((i+j) mod 2)=0 then
begin v[s]:=1 end
else
begin v[s]:=-1 end;
For i:=1 to s do
begin write(v[i]:3)
end;
end;
procedure output_regenerate_matrix;
var i,j,n ,k: integer;
begin
Writeln;
Write('Измененная матрица');
for i:= 1 to n do
begin
tmp:= m[1,i];
m[1,i]:= m[n,i];
m[n,i]:= tmp;
end;
for i:= 1 to n do
begin
writeln;
for j:= 1 to k do
begin write(m[i,j]:6:digits) end;
end;
end;
begin
input_matrix;
output_matrix;
seach_abs_max;
seach_quantum_abs_max;
substitution_meaning_massif;
output_regenerate_matrix;
END.
Очевидно, там не хватает цикла по i, j.