program Almost456;
const size = 3;
type TArray = Array[1..size,1..size] of Integer; // объявляем тип массив
// процедура ввода массива
procedure GetArray(var _MyArray: TArray);
var
i,j: Integer;
begin
for i:= 1 to size do begin
for j:= 1 to size do
Read(_MyArray[i,j]);
ReadLn;
end;
end;
//процедура поиска максимального элемента в четных строках
procedure MaxEvenStr(var _MyArray: TArray; var max: Integer);
var
i,j: Integer;
begin
i:= 2;
max:= _MyArray[2,1];
while (i<=size) do begin
for j:= 1 to size do
if (_MyArray[i,j]>max)
then max:= _MyArray[i,j];
i:= i + 2; // переводим на следующую четную строку
end;
end;
// процедура поиска столбцов с нулевой суммой и заменой элементов этой строки // на максимальный из элементов четных строк
procedure FindZeroColAndReplace(var _MyArray: TArray; var ReplaceValue: Integer);
var
ZeroColNum, // хранит номер столбца с нулевой суммой
i,j,Sum,k : Integer;
begin
for i:= 1 to size do begin
Sum:= 0;
ZeroColNum:= 0;
for j:= 1 to size do begin
Sum:= Sum + _MyArray[j,i];
if (Sum = 0) // если сумма ноль запоминаем номер мтолбца
then ZeroColNum:= i;
end;
if (ZeroColNum > 0) // и заполняем этот столбец максимальным
then for k:= 1 to size do
_MyArray[k,ZeroColNum]:= ReplaceValue;
end;
end;
// функция вывода массива
procedure PrintArray(var _MyArray: TArray);
var
i,j: Integer;
begin
for i:= 1 to size do begin
for j:= 1 to size do
Write(_MyArray[i,j],' ');
WriteLn;
end;
end;
var
MyArray: TArray;
maximum: Integer;
begin
GetArray(MyArray);
MaxEvenStr(MyArray,maximum);
FindZeroColAndReplace(MyArray,maximum);
PrintArray(MyArray);
Writeln('Press <Enter> for exit');
ReadLn;
end.
Поиск столбца сумма,которого равна 0
В матрице имеется столбец,сумма элементов которого равна нулю.Необходимо заменить его элементы на значение максимума,найденного в чётных строках.
В задании только подсчитал суммы столбцов, а вот найти столбец и заменить в чётных строках на значение максимума никак.
Короче вот прога:[ATTACH]3205[/ATTACH]
Помогите доделать.
Извини, копаться в твоем коде как-то не хочется.
Program matr;
Uses crt;
Const
SizeMax=4;
Var
q:array[1..SizeMax,1..SizeMax] Of integer;
i,j,k,im,imax:integer;
h:array [1..SizeMax] Of integer; {сумма столбцов}
Begin
k:=0;
ClrScr;
{оформление}
Writeln('Введите матрицу');
writeln('==============================');
Begin
For i:= 1 to 4 do
Begin
k:=k+1;
Gotoxy(3+i*4,3);
Write(k);
End;
Gotoxy(1,4);
Writeln('==============================');
Gotoxy(23,3);
Writeln('индексы');
Gotoxy(30,3);
Writeln('|');
Gotoxy(30,2);
Writeln('|');
Gotoxy(30,4);
Writeln('|');
{End; - непонятно зачем? 4 раза выводить одно и тоже}
{матрица}
For i:= 1 to 4 do
For j:= 1 to 4 do
Begin
Gotoxy(3+i*4,3+j*2);
Readln(q[i,j]);
End;
End;
{вычисление столбцов }
For j:= 1 to 4 do
Begin
h[1]:=h[1]+q[1,j];
h[2]:=h[2]+q[2,j];
h[3]:=h[3]+q[3,j];
h[4]:=h[4]+q[4,j];
End;
Gotoxy(5,13);
Writeln(' ',h[1],' ',h[2],' ',h[3],' ',h[4]);
Gotoxy(1,12);
Writeln('====================================|');
Gotoxy(1,14);
Writeln('====================================|');
Gotoxy(37,13);
Writeln('|');
Gotoxy(23,13);
Writeln('сумма столбцов');
{поиск столбца равным 0 и замена его в чётных строках}
im:=q[1,1];
i:=2;
{Поиск максимума}
While i<=SizeMax do
Begin
For j:=1 to SizeMax do
If q[j,i]>im then
im:=q[j,i];
i:=i+2;
End;
Gotoxy(1,18);
Writeln('Индекс ',im);
{Заменяем все элементы в столбце, сумма которого равна 0}
For i:=1 to SizeMax do
If h=0 then
For j:=1 to SizeMax do
q[i,j]:=im;
{Выводим полученную матрицу}
WriteLn('Получили матрицу');
For j:=1 to SizeMax do
Begin
For i:=1 to SizeMax do
Write(q[i,j],' ');
WriteLn;
End;
Readkey;
end.
1 -2 3 4
2 3 4 5
3 4 5 6
4 -5 6 7
------------
10 0 18 22 вот получили ответы,видим что 0 получился во 2 столбце
------------ рассматриваем в нём чётные строки это: во 2 строке 3,
в 4 строке -5,понятно что 3 больше -5 и получаем вот это
1 3 3 4
2 3 4 5
3 3 5 6
4 3 6 7
вот вроде бы всё.
Цитата:
блин я вообще не понимаю.Я думал надо ввести матрицу:
1 -2 3 4
2 3 4 5
3 4 5 6
4 -5 6 7
------------
10 0 18 22 вот получили ответы,видим что 0 получился во 2 столбце
------------ рассматриваем в нём чётные строки это: во 2 строке 3,
в 4 строке -5,понятно что 3 больше -5 и получаем вот это
1 3 3 4
2 3 4 5
3 3 5 6
4 3 6 7
вот вроде бы всё.
Собственно это моя программа и делает. Только она ищет максимальный элемент по длине всей четной строки, а не только там, где они пересекаются с нулевым столбцом, например:
1 -2 3 4
2 3 4 5
3 4 5 6
4 -5 6 7
------------
10 0 18 22
------------
1 7 3 4
2 7 4 5
3 7 5 6
4 7 6 7
тк 7 - максимальный элемент среди всех элементов четных строк.
По моему именно это требуется в условии задачи.
Можно конечно и по твоему сделать:
Код:
program Almost456;
const size = 4;
type TArray = Array[1..size,1..size] of Integer;
procedure GetArray(var _MyArray: TArray);
var
i,j: Integer;
begin
for i:= 1 to size do begin
for j:= 1 to size do
Read(_MyArray[i,j]);
ReadLn;
end;
end;
procedure MaxEvenStrAndReplace(var _MyArray: TArray; var ZeroColNum: integer);
var
i,
max: Integer;
begin
i:= 2;
max:= _MyArray[i,ZeroColNum];
while (i<=size) do begin
if (_MyArray[i,ZeroColNum]>max)
then max:= _MyArray[i,ZeroColNum];
i:= i + 2;
end;
for i:= 1 to size do
_MyArray[i,ZeroColNum]:= max;
end;
procedure FindZeroCol(var _MyArray: TArray; var ZeroColNum: Integer);
var
i,j,Sum: Integer;
begin
for i:= 1 to size do begin
Sum:= 0;
ZeroColNum:= 0;
for j:= 1 to size do begin
Sum:= Sum + _MyArray[j,i];
if (Sum = 0)
then begin
ZeroColNum:= i;
break;
end;
end;
if (ZeroColNum>0)
then break;
end;
end;
procedure PrintArray(var _MyArray: TArray);
var
i,j: Integer;
begin
for i:= 1 to size do begin
for j:= 1 to size do
Write(_MyArray[i,j],' ');
WriteLn;
end;
end;
var
MyArray: TArray;
_ZeroColNum: Integer;
begin
GetArray(MyArray);
FindZeroCol(MyArray,_ZeroColNum);
MaxEvenStrAndReplace(MyArray,_ZeroColNum);
PrintArray(MyArray);
Writeln('Press <Enter> for exit');
ReadLn;
end.
const size = 4;
type TArray = Array[1..size,1..size] of Integer;
procedure GetArray(var _MyArray: TArray);
var
i,j: Integer;
begin
for i:= 1 to size do begin
for j:= 1 to size do
Read(_MyArray[i,j]);
ReadLn;
end;
end;
procedure MaxEvenStrAndReplace(var _MyArray: TArray; var ZeroColNum: integer);
var
i,
max: Integer;
begin
i:= 2;
max:= _MyArray[i,ZeroColNum];
while (i<=size) do begin
if (_MyArray[i,ZeroColNum]>max)
then max:= _MyArray[i,ZeroColNum];
i:= i + 2;
end;
for i:= 1 to size do
_MyArray[i,ZeroColNum]:= max;
end;
procedure FindZeroCol(var _MyArray: TArray; var ZeroColNum: Integer);
var
i,j,Sum: Integer;
begin
for i:= 1 to size do begin
Sum:= 0;
ZeroColNum:= 0;
for j:= 1 to size do begin
Sum:= Sum + _MyArray[j,i];
if (Sum = 0)
then begin
ZeroColNum:= i;
break;
end;
end;
if (ZeroColNum>0)
then break;
end;
end;
procedure PrintArray(var _MyArray: TArray);
var
i,j: Integer;
begin
for i:= 1 to size do begin
for j:= 1 to size do
Write(_MyArray[i,j],' ');
WriteLn;
end;
end;
var
MyArray: TArray;
_ZeroColNum: Integer;
begin
GetArray(MyArray);
FindZeroCol(MyArray,_ZeroColNum);
MaxEvenStrAndReplace(MyArray,_ZeroColNum);
PrintArray(MyArray);
Writeln('Press <Enter> for exit');
ReadLn;
end.