Указать номера строк и номера столбцов на пересечении, которых находятся максимальный и минимальный элементы., Дописать код Опции

[dregar55]

Дописать код наработки есть, но чет не могу понять как указать номер строк и столбца мин и мах значения

uses

crt;

var

FText: text;

//создаем свои типы

type

matrix = array [1..15, 1..15] of real;//матрица

arrayB = array [1..50] of real;//матрица-строка

function F(x: real): real;

begin

if x <= 0 then //при х<=-3

F := sqrt(-x) //1-я формула

else if ((x>=0) and (x<5)) then //при х<3

F := x //2-я формула

else //иначе

F := 4*x*x; //3-я формула

end;

//функция инициализации матрицы

function CreateMatrix(n: integer; xn: real; xk: real): matrix;

var

i, j: integer;

x, h: real;

a: matrix;

begin

x := xn;

h := (xk - xn) / (n * n - 1); //высчитываем шаг

for i := 1 to n do //перебираем строки

for j := 1 to n do //перебираем столбцы

begin

a[i, j] := f(x);

x := x + h;//увеличиваем х на шаг;

a[i, j]:=i*n-n+j;// удобно для теста

end;

CreateMatrix := a; //возвращаем матрицу

end;

//функция печати массива

procedure PrintMatrix(a: matrix; n: integer);

var

i, j: integer;

begin

for i := 1 to n do //перебираем строки

begin

for j := 1 to n do //перебираем столбцы

begin

write(a[i, j]:8:2, ' '); //выводим элемент матрицы

write(Ftext,a[i, j]:8:2, ' '); //выводим элемент матрицы

end;

writeln(Ftext,'');

writeln; //после каждой строки переход

end;

end;

//функци замены областей местами

procedure SwapMatrix(var a: matrix; n: integer);

var

i, j, h, h2: integer;

begin

h := n div 2; //высчитвыем номер первой строки второй области

for i := 1 to h do //перебираем строки перволй половины матрицы

begin

for j := 2*i-1 to min(2*i-2+h,n) do //перебираем строки

swap(a[i, j], a[i + h+(n mod 2), j]); //меняем на соответсвующие элмементы второй области

end;

end;

//функция создания матрицы чтроки

function CreateArray(a: matrix; n: integer; var m: integer): arrayB;

var

i, h, j, k: integer;

b: arrayB;

begin

m := 0;

h := n div 2;

for i := 1 to h do

begin

m := m + 1; //увеличиваем индекс в матрице строке

b[m] := a[i,min(2*i-2+h,n)]; //вставляем значение

end;

k:=n;

if n mod 2 = 1 then

i:=i+1

else

k:=n-1;

for j := k downto 1 do

begin

m := m + 1; //увеличиваем индекс в матрице строке

b[m] := a[i,j]; //вставляем значение

end;

k:=0;

for i := i+1 to n do

begin

m := m + 1; //увеличиваем индекс в матрице строке

k:=k+1;

b[m] := a[i,2*k-1]; //вставляем значение

end;

CreateArray := b; //возвращаем результат

end;

//функция печати матрицы-строки

procedure PrintArray(a: arrayB; n: integer);

var

i: integer;

begin

for i := 1 to n do //перебор индексов

begin

write(Ftext,a[i]:8:2, ' ');

write(a[i]:8:2, ' '); //печать элемента

end;

writeln(Ftext,'');

writeln;

end;

//функция сортировки пузырьком

procedure SortArray(var arr: arrayB; m: integer; IsDesc: Boolean);

var

i, j: integer;

k: real;

begin

for i := 1 to m - 1 do //перебор элементов

for j := 1 to m - i do

// если текущий элемент больше или меньше следующего в зависимости от параметра IsDesc

if (arr[j] > arr[j + 1]) and IsDesc or not IsDesc and (arr[j] < arr[j + 1]) then

begin

//то меняем местами элементы

k := arr[j];

arr[j] := arr[j + 1];

arr[j + 1] := k

end;

end;

//покраска элементов

procedure PrintMatrixColor(a: matrix; n: integer);

var

i, j, h, h2: integer;

begin

h := n div 2 ;

h2 := h + n mod 2 ;

for i := 1 to n do //перебор строк

begin

for j := 1 to n do //перебор столбцов

begin

if (i<=h) and (j=min(2*i-2+h,n)) or (i=h2) or (i>h) and (j=2*(i-h2)-1) then //проверка принадлежности стрелок

textcolor(green)

else if (i<=h) and (j>=2*i-1) and (j<=min(2*i-2+h,n))

or (i>h2) and (j>=2*(i-h2)-1) and (j<=min(2*(i-h2)-2+h,n)) then //принадлежность верхенму участку

textcolor(red)

else if (i>h) and (j<=h-(n mod 2)) and (i-h<=j) then //принадлежность нижнему участку

textcolor(Cyan)

else

textcolor(white);

write(a[i, j]:8:2, ' ');

end;

writeln;

end;

textcolor(white);

end;

//поиск минимального и максимального элемента

procedure MinMaxMatrix(var a: matrix; n: integer; var mn: real; var max: real);

var

i, j, h, h2: integer;

begin

h := n div 2 ;

h2 := h + n mod 2 ;

max := a[2, 1]; //изначально считаем что мин и мак элемент по индексу 2,1

mn := a[2, 1];

for i := 1 to n do //перебераем строки

for j := 1 to n do //перебераем столбцы

if not((i<=h) and (j>=2*i-1) and (j<=min(2*i-2+h,n))

or (i>h2) and (j>=2*(i-h2)-1) and (j<=min(2*(i-h2)-2+h,n))) then

begin

if max < a[i, j] then //если тек. элемент больше максимального

max := a[i, j]; //то делаем его максимальным

if mn > a[i, j] then //аналогично для минимального

mn := a[i, j];

end;

end;

// замена элементов в диагонали

procedure SwapDiagonalMatrix(var a: matrix; n: integer);

var

i, j: integer;

min: real;

begin

min:=a[1,n];

for i := 1 to n do //перебераем строки

if min > a[i, i] then //если тек. элемент больше минмльного

min := a[i, i]; //то делаем его минимальным

//если несколько максимальных, то замени все

for i := 1 to n do //перебераем строки

begin

a[i,i] := min;

a[i, n-i+1]:=min;

end;

end;

var

a: matrix;

n, m: integer;

xn, xk, mx, mn: real;

b: arrayB;

begin

//ввод разномернос с проверкой

assign(Ftext,'result.txt');

Rewrite (Ftext);

repeat

write('Введите число в диапазоне от 5 до 15: ');

readln(n);

until (n >= 5) and (n <= 15);

write('Введите x начальное: ');

readln(xn);

write('Введите x конечное: ');

readln(xk);

a := CreateMatrix(n, xn, xk);//создаем матрицу

writeln('Исходная матрица: ');

writeln(Ftext,'Исходная матрица: ');

PrintMatrix(a, n); //печатаем ее

writeln('Измененный массив: ');

writeln(Ftext,'Измененный массив: ');

SwapMatrix(a,n);

PrintMatrix(a, n);

writeln('Массив B: ');

writeln(Ftext,'Массив B: ');

b := CreateArray(a, n, m);

PrintArray(b, m);

writeln('Массив B отсоритрованный по возростанию: ');

writeln(Ftext,'Массив B отсоритрованный по возростанию: ');

SortArray(b,m,true);

PrintArray(b, m);

writeln('Массив B отсоритрованный по убыванию: ');

writeln(Ftext,'Массив B отсоритрованный по убыванию: ');

SortArray(b,m,false);

PrintArray(b, m);

MinMaxMatrix(a,n,mn,mx);

writeln('Максимальный элемент: ',mx:0:3);

writeln('Минимальный элемент: ',mn:0:3);

writeln(Ftext,'Максимальный элемент: ',mx:0:3);

writeln(Ftext,'Минимальный элемент: ',mn:0:3);



close(Ftext);

end.