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

[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.

[OCTAGRAM]

Ну знаете, я тоже не на очном учился и не по специальности, и мне так ещё и не пригодились ни сопромат, ни обработка сигналов, ни материаловедение, и тоже работал на полный день, что не помешало закончить с отличием и ещё язык иностранный по чуть-чуть начать учить. Не серьёзно. Не нашли понимания такие слова. На собеседовании так поговорите, очень вдохновляет.

Если учитесь, то должны. Если не должны, то не учитесь. Вот так очень просто всё понять

Я как обладатель диплома не заинтересован в его девальвации; и как плательщик налогов не заинтересован, чтоб они выбрасывались на тех, кому не надо.

Проблемы у вас не с Паскалём, а ещё, похоже, со школьной программой, с алгебраической геометрией. И с мотивацией. Не задалось с алгемом, можно было опытным путём уже всяко-разно попробовать покрасить матрицу, приближая результат к желаемому. Это не Паскаль, это школа жизни, не с одного, так с другого края подойти к проблеме.