Массивы. Матрицы. Типичные задачи. Опции

[Altair]

Содержание:

• Задание массивов, задание матриц, ввод массивов/матриц
• Решения: Матрицы, Массивы. Задачи (by AlaRic)
• Суммы различных элементов матриц (диагонали, элементы над/под диагоналями, и т.д.)
• Вычисление произведения матриц (квадратных/сцепленных), нахождение детерминанта матрицы(рекурсивное/приведением к диагональному виду)
• Инициализация массивов/матриц случайными значениями
• Заполнение массива по-спирали
• Модуль для работы с динамическими массивами (by Oleg_Z)
• Модуль для работы с динамическими массивами (by Volvo)
• Модуль для работы с матрицами
• Как найти в массиве максимальную последовательность одинаковых символов/максимальную возрастающую последовательность?
• Как задать матрицу, чтобы быстро поменять местами ее строки/столбцы?
• Как вычислить заданный многочлен от матрицы A?
• Как вычислить ранг матрицы?
  
• Нахождение максимальных/минимальных элементов массива

----- ----- ----- ----- -----

Одномерные и многомерные массивы (матрицы) в Паскале.

Задание массивов.
Тип массив в Паскале задается следующим образом:

<имя типа> = ARRAY [<сп.индексов типов>] OF <тип>


Где
<имя типа> - правильный идентификатор.
ARRAY, OF - зарезервированные слова (массив, из)
[<сп.индексов типов>] - список из одного или нескольких индексных типов. (задается размерность массива)
<тип> - любой тип Паскаля, кроме файлового.
После описания типа массива, можно описывать переменные этого типа.

Можно не описывать отдельно тип массив, а описать конкретную переменную, как переменную типа массив:

<variable> : Array[<index>] OF <type>

Где
<variable> - правильный идентификатор.
Array, OF- зарезервированные слова.
<index> - индекс задающий размерность массива.
<type> - любой тип Паскаля, кроме файлового.

Вкачестве индексных типов можно использовать любые порядковые типы, кроме longint
Оюычно в качестве индекстного типа употребляется тип-диапазон, в котором задаются границы изменения индексов.

Вложенные массивы или многомерные или матрицы

Собственно определение матрицы - прямоугольная сетка чисел, справедливо и для многомерных массивов. По сути это и есть матрица.

Задать матрицу в Паскале можно следующим образом:

const
	NN = 10; MM = 10;
type
	matrix = array[1..NN] of array[1..MM] of integer;

В данном случае мы описали матрицу размеров NNxMM.
Т.е. матрица в понимании компилятора - это массив из массивов.

[e1,1]  [e1,2]  [e1,3]  ... [e1,NN]
[e2,1]  [e2,2]  [e2,3]  ... [e2,NN]
...
[eMM,1] [eMM,2] [eMM,3] ... [eMM,NN]

Глубина вложения массивов произвольна.
Т.е. можно задать двухмерный, трехмерный, четырехмерный и так далее массивы.

Если в программе два массива заданы одинаково, то одному массиву можно присвоить другой.
К элементам массива обращаются по индексам.
Пример.

{вывод на экран элемент массива A с индексом 5}
write(A[5]); 

{ввод элемента массива A с индексом 6}
readln(A[6]);

{
  присваиваем элементу массива с индексом 7 сумму эл-тов
  массива A с индексами 5 и 6
} 
A[7]:=A[5]+A[6];

Нуль-основанный символьный массив - это такой массив, в котором индекс первого элемента
равен нулю, а последнего - положительному ненулевому целому числу. Например:

   Array [0..X] Of Char;

Если вы включаете расширенный синтаксис (с помощью директивы компилятора {$X+}), то
нуль-основанный символьный массив может быть инициализирован строкой, длина которой меньше
чем объявленная длина массива.
(в нулевом элемент такого массива хранится длинна строки. см. FAQ по строкам)

Работа с матрицами, ввод матрицы, операции над матрицами, распространенные задачи с матрицами.

Матрица - прямоугольная сетка чисел. Элементы матрицы - числа.
Каждый элемент матрицы имеет два индекса - номер строки и номер столбца, в котором он расположен.
Принято сначала указывать индекс строки, а затем индекс столбца.
Создадим тип матрицы:

const
	NN = 10;	{ число СТРОК! }
	MM = 10;	{ число СТОЛБЦОВ! }
type
	TElem = integer; 
	Matrix = array[1..NN, 1..MM] of TElem;

Очень часто при решении задач, необходимо проходить по всем элементам строки\столбца\строк и столбуов.
Для этого используют цикл со счетчиком. (FOR ... TO ... DO )

Ввод матрицы:
Опишем процедуры ввода и вывода на экран матрицы.

const
	NN = 10;	{ число СТРОК! }
	MM = 10;	{ число СТОЛБЦОВ! }
type
	TElem = integer; 
	Matrix = array[1..NN, 1..MM] of TElem; 
	
(* Построчный ввод матрицы *)
Procedure ReadMatr(var A:Matrix; var n,m:word );
var i, j: word;
begin
	repeat
		write('Введите количество строк: '); readln(N)
	until (N>0) and (N<=NN); 
	repeat
		write('Введите количество столбцов: '); readln(m)
	until (M>0) and (M<=MM);
	For i:=1 to n do begin
		For j:=1 to m do begin
			write('A[',i,j,']= '); readln(A[i,j])
		end 
	end
end; 

(* Построчный вывод матрицы *) 
Procedure PrintMatr(A:Matrix; n,m:word);
Var i, j: word;
begin
	For i:=1 to n do begin
		For j:=1 to m do write(A[i,j],' ');
		writeln
	end
end;

{ тестовая программа} 
var
	n, m: word;
	a: matrix;
begin
	Readmatr(a,n,m);
	PrintMatr(a,n,m)
end.

Сообщение отредактировано: volvo - 13.01.2009 13:35

[Altair]

Подготовил AlaRic:

(в примерах звездочками обозначены элементы, которые будут просуммированы)

Сумма элементов на главной диагонали:

s:=0;
For i:=1 To n Do s:=s+a[i, i];

Пример (Показать/Скрыть)

 * 0 0 0 0
 0 * 0 0 0
 0 0 * 0 0
 0 0 0 * 0
 0 0 0 0 *

Сумма элементов на побочной диагонали:

s:=0;
For i:=1 To n Do s:=s+a[i, n+1-i];

Пример (Показать/Скрыть)

 0 0 0 0 *
 0 0 0 * 0
 0 0 * 0 0
 0 * 0 0 0
 * 0 0 0 0

Сумма элементов, стоящих не выше главной диагонали:

s:=0;
For i:=1 To n Do
  For j:=1 To i Do s:=s+a[i, j];

Пример (Показать/Скрыть)

 * 0 0 0 0
 * * 0 0 0
 * * * 0 0
 * * * * 0
 * * * * *

Сумма элементов, стоящих не ниже главной диагонали:

s:=0;
For i:=1 To n Do
  For j:=i To n Do s:=s+a[i, j];

Пример (Показать/Скрыть)

 * * * * *
 0 * * * *
 0 0 * * *
 0 0 0 * *
 0 0 0 0 *

Сумма элементов, стоящих не ниже побочной диагонали:

s:=0;
For i:=1 To n Do
  For j:=1 To n-i+1 Do s:=s+a[i, j];

Пример (Показать/Скрыть)

 * * * * *
 * * * * 0
 * * * 0 0
 * * 0 0 0
 * 0 0 0 0

Сумма элементов, стоящих не выше побочной диагонали:

s:=0;
For i:=1 To n Do
  For j:=n-i+1 To n Do s:=s+a[i, j];

Пример (Показать/Скрыть)

 0 0 0 0 *
 0 0 0 * *
 0 0 * * *
 0 * * * *
 * * * * *

Сумма всех элементов, стоящих не ниже главной диагонали и не принадлежащих к элементам, стоящим ниже побочной диагонали ("верхний треугольник"):

s:=0;
For i:=1 To n div 2 + n mod 2 Do
  For j:=i To n-i+1 Do s:=s+a[i, j];

Пример (Показать/Скрыть)

 * * * * *
 0 * * * 0
 0 0 * 0 0
 0 0 0 0 0
 0 0 0 0 0

Сумма элементов, стоящих не выше побочной диагонали и не стоящих выше главной диагонали ("нижний треугольник"):

s:=0;
For i:=n mod 2 + n div 2 To n Do
  For j:=n-i+1 To i Do s:=s+a[i, j];

Пример (Показать/Скрыть)

 0 0 0 0 0
 0 0 0 0 0
 0 0 * 0 0
 0 * * * 0
 * * * * *

Сумма элементов, стоящих не выше главной диагонали и одновременно не стоящих ниже побочной диагонали ("левый треугольник"):

s:=0;
For j := 1 To n div 2 + n mod 2 Do
  For i := j To n-j+1 Do s:=s+a[i, j];

Пример (Показать/Скрыть)

 * 0 0 0 0
 * * 0 0 0
 * * * 0 0
 * * 0 0 0
 * 0 0 0 0

Сумма элементов, стоящих не ниже главной диагонали и одновременно не стоящих выше побочной диагонали ("правый треугольник"):

s:=0;
For j := 1 To n div 2 + n mod 2 Do
  For i := j To n-j+1 Do s:=s+a[i, n-j+1];

Пример (Показать/Скрыть)

 0 0 0 0 *
 0 0 0 * *
 0 0 * * *
 0 0 0 * *
 0 0 0 0 *

Сообщение отредактировано: volvo - 28.01.2010 16:10

[Atos]

Кстати, это очень хорошо, что Oleg_Z подготовил подробную справку да ещё ввод-вывод стандартного массива. Я думаю, можно будет, если новичкам понадобится какое-то задание на массив(статический), просто написать им процедуру , решающую задачу с массивом именно этого типа Matrix, и сразу отослать их к этой теме. Тогда будет меньше и лишей работы, и лишних вопросов.
Ну и глава про массивы из учебника Фаронова:
http://www.borlpasc.narod.ru/docym/Faronov/gl4/gl4_5.html

[Altair]

Вычисление произведения квадратных матриц.

type
 TElem=integer;
const
 Count = 3; {кол-во столбцов и строк матрицы}
var
 Mat1, Mat2,                                     {вводимые матрицы}
 ResMat1 : array[1..Count, 1..Count] of TElem; {результирующая}
 i, x, y, R : integer;
 flag : boolean;

begin
 Writeln('Ввод первой матрицы (целые числа)');
 for y := 1 to Count do
  for x := 1 to Count do
  begin
   Write('Mat1[', x, ',', y,'] : ');
   Readln(Mat1[x, y]);
  end;
 Writeln('Ввод второй матрицы (целые числа)');
 for y := 1 to Count do
  for x := 1 to Count do
  begin
   Write('Mat2[', x, ',', y,'] : ');
   Readln(Mat2[x, y]);
  end;
 {подсчет матрицы AxB}
 for y := 1 to count do {спускаемся вниз по строкам}
  for x := 1 to Count do {идем по элементам строк вправо}
  begin
   R := 0;                          {обнуляем сумму произведений}
   for i := 1 to Count do           {идем под горизонтали Mat1 и по вертикали}
    r := R + mat1[y, i]*Mat2[i, x]; {Mat2; умножаем и добавляем в R}
   ResMat1[x, y] := R;              {Resmat1[x, y] = результат = R}
 end;
 Writeln('AxB='); {выводим на экран}
 for y := 1 to Count do
 begin
  for x := 1 to Count do
   Write(ResMat1[x, y]:4);
  Writeln;
 end;
END.

Вычисление детерминанта (определителя) матрицы
приведением к диагональному виду.

(С) trminator

program denominator;
const
  MaxN=3;
  epsilon=1E-10
type
  matrix=array[1..maxN,1..maxN] of Real;
var
  a: matrix;
  i,j: integer;
  determ:real;

function det(a:matrix;n:integer):real;
var i,j,k:integer; d:real;
begin
  for i:=1 to pred(n) do begin
    if abs(a[i,i])<epsilon then begin
      det:=0.0; exit
    end;

    for j:=succ(i) to n do begin
      d:=a[j,i]/a[i,i];
      for k:=i to n do
        a[j,k]:=a[j,k]-d*a[i,k];
    end;
  end;

  d:=1.0;
  for i:=1 to n do d:=d*a[i,i];
  det:=d;
end;

begin
  for i:=1 to MaxN do
    for j:=1 to MaxN do read(a[i,j]);
  determ:=det(a,3);
  WriteLn(determ:0:0)
end.

[volvo]

Вычисление произведения "сцепленных" матриц.

Например:
(2, 3) Х (3, 3) = (2, 3)
(3, 2) Х (2, 5) = (3, 5)

Type
  TType = Integer;

Const
  nRowFirst  = 3; { Количество строк первой матрицы }
  nCommon    = 2; { Количество столбцов первой и строк второй матрицы }
  nColSecond = 5; { Количество столбцов второй матрицы }

Type
  TFirst = { Тип данных для хранения первой матрицы }
    Array[1 .. nRowFirst, 1 .. nCommon] Of TType; 
  TSecond = { Тип данных для хранения второй матрицы }
    Array[1 .. nCommon, 1 .. nColSecond] Of TType; 
  TResult = { Тип данных для хранения результата }
    Array[1 .. nRowFirst, 1 .. nColSecond] Of TType; 

{ Собственно процедура перемножения матриц: (res) = (a) X (B) }
Procedure matrixMult(Var res: TResult;
          a: TFirst; b: TSecond);
  Var i, j, k: Integer;
  Begin
    For i := 1 To nRowFirst Do
      For j := 1 To nColSecond Do
        Begin
          res[i, j] := 0;
          For k := 1 To nCommon Do
            res[i, j] := res[i, j] + a[i, k] * b[k, j];
        End
  End;

var
  iRow, iCol: Integer;
  m1: TFirst; m2: TSecond;
  mr: TResult;
begin
  WriteLn('Ввод первой матрицы: (', nRowFirst, 'x', nCommon, ')');
  For iRow := 1 To nRowFirst Do
    For iCol := 1 To nCommon Do
      Begin
        Write('m1[', iRow, ',', iCol,'] : ');
        ReadLn(m1[iRow, iCol])
      End;

  WriteLn('Ввод второй матрицы: (', nCommon, 'x', nColSecond, ')');
  For iRow := 1 To nCommon Do
    For iCol := 1 To nColSecond Do
      Begin
        Write('m2[', iRow, ',', iCol,'] : ');
        ReadLn(m2[iRow, iCol])
      End;

  matrixMult(mr, m1, m2); { Вызов процедуры перемножения }

  WriteLn('Результирующая матрица: (', nRowFirst, 'x', nColSecond, ')');
  For iRow := 1 To nRowFirst Do
    Begin
      For iCol := 1 To nColSecond Do
        Write(mr[iRow, iCol]:4);
      WriteLn
    End;
end.

Вычисление детерминанта (определителя) матрицы с помощью рекурсии.

Const
  max_n = 4;

Type
  matrix = Array[1 .. max_n, 1 .. max_n] Of real;

{ Матрица, для которой будет вычисляться определитель }
Const 
 a: matrix =
   ((2, 9, 9, 4),
    (2, -3, 12, 8),
    (4, 8, 3, -5),
    (1, 2, 6, 4));

function minusOne(n: integer): integer;
  begin
    minusOne := (1 - 2*Byte(Odd(n)));
  end;

function get_addr(i, j: integer;
         const n: integer): integer;
  begin
    get_addr := pred(i) * n + j
  end;

{ Рекурсивное определение определителя }
Function det(Var p; Const n: integer): real;
  Type
    matrix = Array[1 .. max_n * max_n] Of real;
  Var
    my_p: matrix Absolute p;
    pp: ^matrix;
    s: real;
    i, j, curr: integer;
  Begin
    s := 0.0;

    If n = 2 Then
      Begin
        det := my_p[1]*my_p[4] - my_p[2]*my_p[3]; exit
      End;

    For i := 1 To n Do
      Begin
        GetMem(pp, Sqr(Pred(n)) * SizeOf(real));
        curr := 1;
        For j := 1 To n Do
          If j <> i Then
            Begin
              move(my_p[get_addr(j, 2, n)], pp^[get_addr(curr, 1, Pred(n))],
                   pred(n) * SizeOf(real));
              inc(curr);
            End;

        s := s + minusOne(Succ(i)) * my_p[get_addr(i, 1, n)] *
                 det(pp^, Pred(n));
        FreeMem(pp, Sqr(Pred(n)) * SizeOf(real))
      End;

    det := s
  End;

begin
  WriteLn( det(a, 4):0:0 );
end.

Скачать:  REC_DET.PAS ( 1.28 килобайт ) Кол-во скачиваний: 1314

[Флогримм]

Инициализация массивов случайными значениями

1. Одномерный массив

const 
  n=10; {длина одномерного массива}
  k=100;

var 
  mas:array[1..n] of integer;
  i:integer;

begin
  { Включаем генератор случайных чисел }
  randomize;
  { Присваиваем очередному значению случайное число в интервале [0;k) }
  for i:=1 to n do mas[i]:=random(k);
end.

2. Двумерный массив (матрица)

const 
  n=10; { Количество столбцов }
  m=15; { Количество строк массива }
  k=100;

var 
  mas:array[1..n, 1..m] of integer;
  i,j:integer;

begin
  randomize;
  for i:=1 to n do
    for j:=1 to m do
      mas[i,j]:=random(k);
end.

Random (функция)
------------------
Возвращает случайное число.

Объявление:
Function Random [ ( Range : Word) ] : < тип параметра >;

Режим:
Windows, Real, Protected

Замечания:
Если параметр Range не определен, то результатом будет случайное число типа Real в диапазоне 0 <= X < 1. Если параметр Range определен, то результатом будет случайное число в диапазоне 0 <= X < Range.

Если Range равняется 0, то значение 0 и будет возвращено.

Чтобы инициализировать генератор случайных чисел, вызовите процедуру Randomize или присвойте значение переменной RandSeed.

[Флогримм]

Заполнение массива по-спирали
(начиная с верхнего левого угла по часовой стрелке)

program spirall;
uses crt;
const
  Size=7;
  k=-1; {"пустая ячейка" содержит значение k}
var
  mas:array[1..size,1..size]of shortint;
  i,j,a:integer;

function freemas(i,j: shortint): boolean;
begin                                     
  if (i<1) or (i>size) or (j<1) or (j>size)
  then freemas:=false
  else freemas:=(mas[i,j]=k);
end;

procedure draw; {печать массива}
begin
  writeln;
  for i:=1 to size do begin
    for j:=1 to size do write(mas[i,j]:2,'|');
    writeln;
  end;
end;

begin
  for i:=1 to size do
    for j:=1 to size do mas[i,j]:=k; {заполнение массива "пустыми ячейками"}

  clrscr;
  i:=1;
  j:=1;
  mas[i,j]:=1;

  for a:=1 to sqr(size)-1 do
  begin
    if (freemas(i-1,j)) and (not freemas(i,j-1)) then begin dec(i); mas[i,j]:=a+1; end else
    if freemas(i,j+1) then begin inc(j); mas[i,j]:=a+1; end else
    if freemas(i+1,j) then begin inc(i); mas[i,j]:=a+1; end else
    if freemas(i,j-1) then begin dec(j); mas[i,j]:=a+1; end else
    continue;
  end;

  draw;
end.

Пример заполнения (Показать/Скрыть)

 1| 2| 3| 4| 5| 6| 7|
24|25|26|27|28|29| 8|
23|40|41|42|43|30| 9|
22|39|48|49|44|31|10|
21|38|47|46|45|32|11|
20|37|36|35|34|33|12|
19|18|17|16|15|14|13|

Сообщение отредактировано: volvo - 8.03.2010 15:00

[volvo]

Как найти в массиве максимальную последовательность одинаковых символов?

Как найти в массиве максимальную возрастающую последовательность символов?

[volvo]

Как задать матрицу, чтобы быстро поменять местами ее строки / столбцы

[volvo]

Как вычислить заданный многочлен от матрицы A

[volvo]

Как вычислить ранг матрицы

(by SKVOZNJAK)

Исходный код

const
max_rows = 3;
max_cols = 4;
MaxNij=4;

type
TType = real;
mxType =
array[1 .. max_rows, 1 .. max_cols] of TType;

{ Матрица, ранг которой требуется определить }
const
arr: mxType =
(( 1, -2, -3, 0),
( 2, 3, 8, 7),
(-1, 1, 1, -1));

{ Дополнительные функции }
function incr_(var x: integer): integer;
begin
incr_ := x; inc(x)
end;
function decr_(var x: integer): integer;
begin
decr_ := x; dec(x)
end;
function minusOnePower(n: integer): integer;
begin
minusOnePower := (1 - 2*byte(odd(n)));
end;

{ Нахождение определителя матрицы }
function opr(const a: mxType; k: word): TType;
var
B: mxType;
i, j, E: word;
q: integer;
s: TType;
begin
if k = 2 then { Условие выхода из рекурсии }
Opr:= a[1, 1] * a[2, 2] -
a[1, 2] * a[2, 1]

else begin
s := 0;
for E := 1 to K do begin
for i := 2 to K do begin
q := 1;
for j := 1 to K do
if (j <> E) then
B[pred(i), incr_(q)] := a[i, j]
end;
s := s + minusOnePower(E) *
a[1, E] * Opr(B, pred(k))
end;
Opr := s
end
end;

function get_rang(ni, nj: integer;
a: mxType): integer;
type
TVariant = (Process, Ok, Stop); { Тип текущего процесса }
var
T1, T2: mxType; { Временные массивы }

{ Для создания всех возможных перестановок строк и столбцов.
Элемент 0 служит для предотвращения переполнения }
Pi, Pj: array[0 .. maxNij] of byte;
i, j,
k: integer; { Размер квадратной матрицы для расчета определителя}

{ Служат для построения перестановок строк и столбцов }
whatInPi: array[1 .. max_rows] of boolean;
whatInPj: array[1 .. max_cols] of boolean;

f, f2: TVariant; { Флаги }
Opred: TType;
const
flag: boolean = false;
rang: integer = 0;
begin
k := 1;
for i := 1 to pred(ni) do Pi[i] := i;
Pi[ni] := pred(ni);

while not flag do begin
{ Подготовка массивов перестановок }
for i := 1 to pred(nj) do Pj[i] := i;
Pj[nj] := pred(nj);

{ Построим все комбинации по строкам }
f := Process;
while f = Process do begin
i := ni;
inc(Pi[i]);
while (i <> 0) and (Pi[i] > ni) do begin
{ Получение следующих комбинаций }
Pi[decr_(i)] := 1;
inc(Pi[i])
end;

if i = 0 then begin
f := Stop; flag := true
end
else begin
{ Проверка повторений элементов в комбинации }
for i := 1 to ni do
WhatInPi[i] := false;

i := 1;
while (i <= ni) and (not WhatInPi[Pi[i]]) do
WhatInPi[Pi[incr_(I)]] := true;

if i > ni then f := Ok
end;

end;

{ Построим все комбинации по столбцам }
f2 := Process;
while (f2 <> Stop) and (not flag) do begin

f2 := Process;
while f2 = Process do begin
i := nj;
inc(Pj[i]);
while (i <> 0) and (Pj[i] > nj) do begin
Pj[decr_(i)] := 1;
inc(Pj[i])
end;

if i = 0 then f2 := Stop
else begin
for i := 1 to nj do
WhatInPj[i] := false;

i := 1;
while (i <= nj) and (not WhatInPj[Pj[i]]) do
WhatInPj[Pj[incr_(i)]] := true;

if i > nj then f2 := Ok
end;
end;

if f2 = Ok then begin
{ Составление матрицы }
for i := 1 to ni do
for j := 1 to nj do
T1[i, j] := a[Pi[i], j];

for i := 1 to k do
for j := 1 to k do
T2[i, j] := T1[i, Pj[j]];

{ Считаем определитель }
if k > 1 then Opred := Opr(T2, k)
else Opred := T2[1, 1];

if Opred <> 0 then f2 := Stop
end
end;

if (Opred <> 0) and (not flag) then begin
rang := incr_(k);
for i := 1 to pred(ni) do Pi[i] := i;
Pi[ni] := pred(ni)
end;

flag := (k > ni) or (k > nj) or flag
end;
get_rang := rang
end;

begin
writeln('rang = ', get_rang(max_rows, max_cols, arr))
end.

Исходный текст программы (без комментариев) можно скачать здесь:
 _RANG.PAS ( 3.54 килобайт ) Кол-во скачиваний: 2007

[Archon]

Нахождение максимальных/минимальных элементов массива

Как найти максимальный элемент массива

const 
	n = 10; { Число элементов массива }
var 
	arr: array[1..n] of integer;
	i, max: integer;
begin
	{ Заполняем массив случайными элементами и выводим его на экран }
	Randomize;
	Write('Сгенерированный массив:');
	for i := 1 to n do begin
		arr[i] := random(100);
		Write(' ', arr[i]);
	end;
	WriteLn;
	
	{ Для начала предположим, что первый элемент массива является максимальным }
	max := arr[1];
	
	{ Просматриваем оставшиеся элементы }
	for i := 2 to n do begin
		{ Если следующий элемент больше, чем уже запомненный, запоминаем его }
		if arr[i] > max then max := arr[i];
	end;
	
	WriteLn('Максимальный элемент - ', max);
end.

Как найти 2 максимальных элемента массива

const 
	n = 10; { Число элементов массива }
var 
	arr: array[1..n] of integer;
	i, max1, max2, temp: integer;
begin
	{ Заполняем массив случайными элементами и выводим его на экран }
	Randomize;
	Write('Сгенерированный массив:');
	for i := 1 to n do begin
		arr[i] := random(100);
		Write(' ', arr[i]);
	end;
	WriteLn;
	
	{ Для начала предположим, что первые элементы массива являются максимальными }
	{ (Предпологается, что в массиве есть хотя бы два элемента) }
	max1 := arr[1];
	max2 := arr[2];
	{ Пусть больший из них будет в max1, а меньший в max2 }
	if max1 < max2 then begin
		temp := max1;
		max1 := max2;
		max2 := temp;
	end;
	
	{ Просматриваем оставшиеся элементы }
	for i := 3 to n do begin
		{ Если следующий элемент больше, чем минимальный из уже запомненных, запоминаем его }
		if arr[i] > max2 then max2 := arr[i];
		{ Удостоверяемся, что больший по прежнему в max1 }
		if max1 < max2 then begin
			temp := max1;
			max1 := max2;
			max2 := temp;
		end;
	end;
	
	WriteLn('Максимальный элемент - ', max1);
	WriteLn('Следующий за ним - ', max2);
end.

Как найти k максимальных элементов массива

const 
	n = 10; { Число элементов массива }
	k = 5;  { Число искомых максимумов }
var 
	arr: array[1..n] of integer;
	max: array[1..k] of integer;
	i, j, minmax, temp: integer;
begin
	{ Заполняем массив случайными элементами и выводим его на экран }
	Randomize;
	Write('Сгенерированный массив:');
	for i := 1 to n do begin
		arr[i] := random(100);
		Write(' ', arr[i]);
	end;
	WriteLn;
	
	{ Для начала предположим, что первые элементы массива являются максимальными }
	{ (Предпологается, что в массиве есть хотя бы k элементов) }
	for i := 1 to k do max[i] := arr[i];
	
	{ Просматриваем оставшиеся элементы }
	for i := k + 1 to n do begin
		{ Найдём номер минимального из максимальных }
		minmax := 1;
		for j := 2 to k do
			if max[j] < max[minmax] then minmax := j;
		{ Если следующий элемент больше, чем минимальный из уже запомненных, запоминаем его }
		if arr[i] > max[minmax] then max[minmax] := arr[i];
	end;
	
	Write('Неотсортированный список максимальных элементов:');
	for i := 1 to k do
		Write(' ', max[i]);
	WriteLn;
end.

Для нахождения минимумов, нужно поменять все знаки сравнения на противоположные и, для порядка, изменить названия переменных.