unit Arrays;

interface

type
// Типы двумерных динамических массивов строк (TArrayS2),
// целых (TArrayI2) и действительных (TArrayR2) чисел
     TArrayS2 = array of array of string;
     TArrayI2 = array of array of integer;
     TArrayR2 = array of array of real;

// Типы функций сравнения массивов строк (TCompareSArray),
// целых (TCompareIArray) и
// действительных (TCompareRArray) чисел
// Используются в вариантах перегруженных процедур
// Bubble2, MinSort2, функций Index2 с параметром Compare
// Функции должны возвращать true, если X1 >= X2,
// и false, если X1 < X2
     TCompareSArray = function(X1, X2: array of string): boolean;
     TCompareIArray = function(X1, X2: array of integer): boolean;
     TCompareRArray = function(X1, X2: array of real): boolean;

// Тип массива, используемый в функциях Index2,
// функциях поиска и StepSort
     TArrayI1 = array of integer;

// Типы массивов, используемые в функциях поиска и StepSort
     TArrayS1 = array of string;
     TArrayR1 = array of real;

var
// ShowErrorArray - надо ли показывать окна с сообщениями
// об ошибках
// Если ShowErrorArray = false, то ErrorArray показывает,
// были ли ошибки, а MessageArray содержит
// последнее сообщение об ошибке
    ShowErrorArray: boolean = false;
    ErrorArray: boolean = false;
    MessageArray: string;

// Переменные - функции
// Используются в вариантах перегруженных процедур
// Bubble2, MinSort2, функций Index2
// без параметра Ind или Compare
// Функции должны возвращать true, если X1 >= X2,
// и false, если X1 < X2
    CompareSArray: function(X1, X2: array of string): boolean;
    CompareIArray: function(X1, X2: array of integer): boolean;
    CompareRArray: function(X1, X2: array of real): boolean;

// ********************************************************
// Пузырьковая сортировка
// ********************************************************

// Пузырьковая сортировка массива M
// строк, целых и действительных чисел
procedure BubbleStr(var M: array of string);
procedure BubbleInt(var M: array of integer);
procedure BubbleReal(var M: array of real);

// Пузырьковая сортировка двумерного массива M
// строк, целых или действительных чисел
// Ind - индекс элемента строки,
// по которому ведется сортировка
procedure Bubble2(var M: TArrayS2; Ind:word); overload;
procedure Bubble2(var M: TArrayI2; Ind:word); overload;
procedure Bubble2(var M: TArrayR2; Ind:word); overload;

// Пузырьковая сортировка двумерного массива M
// целых или действительных чисел
// с внешней функцией сравнения
// (CompareSArray, или CompareIArray, или CompareRArray)
procedure Bubble2(var M: TArrayS2); overload;
procedure Bubble2(var M: TArrayI2); overload;
procedure Bubble2(var M: TArrayR2); overload;

// Пузырьковая сортировка двумерного массива M
// строк, целых или действительных чисел
// Compare - функция сравнения
procedure Bubble2(var M: TArrayS2;
                      Compare: TCompareSArray); overload;
procedure Bubble2(var M: TArrayI2;
                      Compare: TCompareIArray); overload;
procedure Bubble2(var M: TArrayR2;
                       Compare: TCompareRArray); overload;

// ********************************************************
// Добавление нового элемента в сортированный массив
// ********************************************************


// Добавление нового элемента New в сортированный массив M
// строк, целых и действительных чисел
procedure StepSort(var M: TArrayS1; New: string); overload;
procedure StepSort(var M: TArrayR1; New: real); overload;
procedure StepSort(var M: TArrayI1; New: integer); overload;

// ********************************************************
// Сортировка с выброром минимального элемента
// ********************************************************

// Сортировка массива M
// строк, целых и действительных чисел
// с выброром минимального элемента
procedure MinSortStr(var M: array of string);
procedure MinSortInt(var M: array of integer);
procedure MinSortReal(var M: array of real);

// Сортировка двумерного массива M
// строк, целых или действительных чисел
// с выброром минимального элемента
// Ind - индекс элемента,
// по которому ведется сортировка
procedure MinSort2(var M: TArrayS2; Ind:word); overload;
procedure MinSort2(var M: TArrayI2; Ind:word); overload;
procedure MinSort2(var M: TArrayR2; Ind:word); overload;

// Сортировка двумерного массива M
// строк, целых или действительных чисел
// с выброром минимального элемента
// с внешней функцией сравнения
// (CompareSArray, или CompareRArray)
procedure MinSort2(var M: TArrayS2); overload;
procedure MinSort2(var M: TArrayI2); overload;
procedure MinSort2(var M: TArrayR2); overload;

// Сортировка двумерного массива M
// строк, целых или действительных чисел
// с выброром минимального элемента
// Compare - функция сравнения
procedure MinSort2(var M: TArrayS2;
                      Compare: TCompareSArray); overload;
procedure MinSort2(var M: TArrayI2;
                      Compare: TCompareIArray); overload;
procedure MinSort2(var M: TArrayR2;
                       Compare: TCompareRArray); overload;

// ********************************************************
// Построение индекса сортировкой
// с выброром минимального элемента
// ********************************************************

// Построение индекса двумерного массива M
// строк, целых или действительных чисел
// сортировкой с выброром минимального элемента
// Ind - индекс элемента,
// по которому ведется сортировка
// Возвращают индексный массив
function Index2(const M: TArrayS2; Ind:word): TArrayI1; overload;
function Index2(const M: TArrayI2; Ind:word): TArrayI1; overload;
function Index2(const M: TArrayR2; Ind:word): TArrayI1; overload;

// Построение индекса двумерного массива M
// строк, целых или действительных чисел
// сортировкой с выброром минимального элемента
// с внешней функцией сравнения
// (CompareSArray, или CompareIArray, или CompareRArray)
// Возвращают индексный массив
function Index2(const M: TArrayS2): TArrayI1; overload;
function Index2(const M: TArrayI2): TArrayI1; overload;
function Index2(const M: TArrayR2): TArrayI1; overload;

// Построение индекса двумерного массива M
// строк, целых или действительных чисел
// сортировкой с выброром минимального элемента
// Compare - функция сравнения
// Возвращают индексный массив
function Index2(const M: TArrayS2;
                Compare: TCompareSArray): TArrayI1; overload;
function Index2(const M: TArrayI2;
                Compare: TCompareIArray): TArrayI1; overload;
function Index2(const M: TArrayR2;
                Compare: TCompareRArray): TArrayI1; overload;

// ********************************************************
// Поиск в несортированном массиве
// ********************************************************

// Поиск точного совпадения заданного значания X
// и элемента с индексом Ind
// строки двумерного несортированного массива M
// Row - найденная строка, первый ее элемент - индекс строки
// Если соответствие не найдено, возвращается false
function FindS(const M: TArrayS2; X:string; Ind: integer;
                   out Row: TArrayS1): boolean;
function FindI(const M: TArrayI2; X, Ind: integer;
                   out Row: TArrayI1): boolean;
function FindR(const M: TArrayR2; X: real; Ind: integer;
                   out Row: TArrayR1): boolean;

// Поиск ближайшего соответствия заданного значания X
// и элемента с индексом Ind
// строки двумерного несортированного массива M
// Row - найденная строка, первый ее элемент - индекс строки
procedure FindNearS(const M: TArrayS2; X:string;
                    Ind: integer; out Row: TArrayS1);
procedure FindNearI(const M: TArrayI2; X, Ind: integer;
                   out Row: TArrayI1);
procedure FindNearR(const M: TArrayR2; X: real; Ind: integer;
                   out Row: TArrayR1);

// Поиск заданного значания X в элементах с индексом Ind
// строки двумерного несортированного массива M
// с линейной интерполяцией
// Row - результирующая строка
// Если X > максимального или < минимального элемента,
// то возвращается ближайшая строка
procedure InterpR(const M: TArrayR2; X: real; Ind: integer;
                   out Row: TArrayR1);

// ********************************************************
// Поиск в сортированном массиве
// ********************************************************

// Поиск методом дихотомии
// точного совпадения заданного значания X
// и элемента с индексом Ind
// строки сортированного массива M
// Row - найденная строка, первый ее элемент - индекс строки
// Если соответствие не найдено, возвращается false
function FindSSort(const M: TArrayS2; X: string;
                   Ind: integer; out Row: TArrayS1): boolean;
function FindISort(const M: TArrayI2; X, Ind: integer;
                   out Row: TArrayI1): boolean;
function FindRSort(const M: TArrayR2; X: real; Ind: integer;
                   out Row: TArrayR1): boolean;

// Поиск ближайшего соответствия заданного значания X
// и элемента с индексом Ind
// строки сортированного массива M
// Row - найденная строка, первый ее элемент - индекс строки
procedure FindNearSSort(const M: TArrayS2; X: string;
                        Ind: integer; out Row: TArrayS1);
procedure FindNearISort(const M: TArrayI2; X, Ind: integer;
                   out Row: TArrayI1);
procedure FindNearRSort(const M: TArrayR2; X: real; Ind: integer;
                   out Row: TArrayR1);

// Поиск заданного значания X в элементах с индексом Ind
// строки сортированного массива M
// с линейной интерполяцией
// Row - результирующая строка
// Если X > максимального или < минимального элемента,
// то возвращается ближайшая строка
procedure InterpRSort(const M: TArrayR2; X: real; Ind: integer;
                   out Row: TArrayR1);

// Только для Delphi 5 и 4 объявленние функции Sign
{$IFDEF VER130} {$DEFINE VERLESS6} {$ENDIF}
{$IFDEF VER120} {$DEFINE VERLESS6} {$ENDIF}
{$IFDEF VERLESS6}
// Возвращают -1 при X < 0, 0 при X = 0, 1 при X > 0
function Sign(X: Extended): integer; overload;
function Sign(X: integer): integer; overload;
{$ENDIF}

implementation

uses Forms,   // Для переменной Application
     Windows, // Для обозначений флагов кнопок Application.MessageBox
     SysUtils,// Для функции Abort
     Math;

// Только для Delphi 5 и 4
{$IFDEF VERLESS6}
function Sign(X: Extended): integer;
// Возвращает -1 при X < 0, 0 при X = 0, 1 при X > 0
begin
 if(X < 0.0) then Result := -1
 else if(X = 0.0) then Result := 0
 else Result := 1;
end;

function Sign(X: integer): integer;
// Возвращает -1 при X < 0, 0 при X = 0, 1 при X > 0
begin
 if(X < 0) then Result := -1
 else if(X = 0) then Result := 0
 else Result := 1;
end;
{$ENDIF}

procedure Messages(S:string);
// Обработка сообщений об ошибках в процедурах
begin
 if ShowErrorArray then begin
   Application.MessageBox(PChar(S), 'Ошибка', MB_OK+MB_ICONSTOP);
   Abort;
 end
 else begin
  ErrorArray := true;
  MessageArray := S;
 end;
end;

procedure BubbleStr(var M: array of string);
// Пузырьковая сортировка массива строк
// i, j: счетчики циклов
// N: максимальный индекс массива
// Rtmp: переменная, используемая при перестановках
// noswap: значение true показывает, что при проходе
//         не было перестановок
var i, j, N: integer;
    Rtmp: string;
    noswap: boolean;
begin
 N := High(M);
 for i:=0 to N-1 do begin
  noswap := true;
  for j:=N-1 downto i do
  if AnsiCompareText(M[j],M[j+1]) > 0
    then begin
     // Перестановка элементов M[j] и M[j+1]
     Rtmp := M[j+1];
     M[j+1] := M[j];
     M[j] := Rtmp;
     noswap := false;
    end;
  if(noswap) then exit;
 end;
end;

procedure BubbleInt(var M: array of integer);
// Пузырьковая сортировка массива целых чисел
// i, j: счетчики циклов
// N: максимальный индекс массива
// Rtmp: переменная, используемая при перестановках
// noswap: значение true показывает, что при проходе
//         не было перестановок
var i, j, N, Rtmp: integer;
    noswap: boolean;
begin
 N := High(M);
 for i:=0 to N-1 do begin
  noswap := true;
  for j:=N-1 downto i do
  if M[j] > M[j+1]
    then begin
     // Перестановка элементов M[j] и M[j+1]
     Rtmp := M[j+1];
     M[j+1] := M[j];
     M[j] := Rtmp;
     noswap := false;
    end;
  if(noswap) then exit;
 end;
end;

procedure BubbleReal(var M: array of real);
// Пузырьковая сортировка массива действительных чисел
// i, j: счетчики циклов
// N: максимальный индекс массива
// Rtmp: переменная, используемая при перестановках
// noswap: значение true показывает, что при проходе
//         не было перестановок
var i, j, N: integer;
    Rtmp: real;
    noswap: boolean;
begin
 N := High(M);
 for i:=0 to N-1 do begin
  noswap := true;
  for j:=N-1 downto i do
  if M[j] > M[j+1]
    then begin
     // Перестановка элементов M[j] и M[j+1]
     Rtmp := M[j+1];
     M[j+1] := M[j];
     M[j] := Rtmp;
     noswap := false;
    end;
  if(noswap) then exit;
 end;
end;

procedure Bubble2(var M: TArrayS2; Ind:word);
// Пузырьковая сортировка двумерного массива строк M
// Ind - индекс строки по которой ведется сортировка
// в строке массива M
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки массива
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Rtmp: переменная, используемая при перестановках
// noswap: значение true показывает, что при проходе
//         не было перестановок
var i, j, k, N1, N2: integer;
    Rtmp: string;
    noswap: boolean;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре Bubble2 :' +
              #13'не задан массив строк');
     exit;
   end;
 N2 := High(M[0]);
 if(Ind > N2)
   then begin
     Messages('Ошибка в процедуре Bubble2 :' +
              #13'индекс ' + IntToStr(Ind)+
              ' превышает максимальный индекс массива ' +
              IntToStr(N2));
     exit;
   end;
 for i:=0 to N1-1 do begin
  noswap := true;
  for j:=N1-1 downto i do
  if (AnsiCompareText(M[j, Ind],M[j+1, Ind]) > 0)
    then begin
      for k:=0 to N2 do begin
       // Перестановка строк j и j+1
       Rtmp := M[j+1,k];
       M[j+1,k] := M[j,k];
       M[j,k] := Rtmp;
      end;
      noswap := false;
     end;
  if(noswap) then exit;
 end;
end;

procedure Bubble2(var M: TArrayI2; Ind:word);
// Пузырьковая сортировка двумерного массива M
// целых чисел
// Ind - индекс элемента строки,
// по которому ведется сортировка
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Rtmp: переменная, используемая при перестановках
// noswap: значение true показывает, что при проходе
//         не было перестановок
var i, j, k, N1, N2, Rtmp: integer;
    noswap: boolean;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре Bubble2 :' +
              #13'не задан массив целых чисел');
     exit;
   end;
 N2 := High(M[0]);
 if(Ind > N2)
   then begin
     Messages('Ошибка в процедуре Bubble2 :' +
              #13'индекс ' + IntToStr(Ind)+
              ' превышает максимальный индекс массива ' +
              IntToStr(N2));
     exit;
   end;
 for i:=0 to N1-1 do begin
  noswap := true;
  for j:=N1-1 downto i do
  if M[j, Ind] > M[j+1, Ind]
    then begin
      for k:=0 to N2 do begin
       // Перестановка строк j и j+1
       Rtmp := M[j+1,k];
       M[j+1,k] := M[j,k];
       M[j,k] := Rtmp;
      end;
      noswap := false;
     end;
  if(noswap) then exit;
 end;
end;

procedure Bubble2(var M: TArrayR2; Ind:word);
// Пузырьковая сортировка двумерного массива M
// действительных чисел
// Ind - индекс элемента строки,
// по которому ведется сортировка
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Rtmp: переменная, используемая при перестановках
// noswap: значение true показывает, что при проходе
//         не было перестановок
var i, j, k, N1, N2: integer;
    Rtmp: real;
    noswap: boolean;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре Bubble2 :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
 N2 := High(M[0]);
 if(Ind > N2)
   then begin
     Messages('Ошибка в процедуре Bubble2 :' +
              #13'индекс ' + IntToStr(Ind) +
              ' превышает максимальный индекс массива ' +
              IntToStr(N2));
     exit;
   end;
 for i:=0 to N1-1 do begin
  noswap := true;
  for j:=N1-1 downto i do
  if M[j, Ind] > M[j+1, Ind]
    then begin
      for k:=0 to N2 do begin
       // Перестановка строк j и j+1
       Rtmp := M[j+1,k];
       M[j+1,k] := M[j,k];
       M[j,k] := Rtmp;
      end;
      noswap := false;
     end;
  if(noswap) then exit;
 end;
end;

procedure Bubble2(var M: TArrayS2);
// Пузырьковая сортировка двумерного массива M строк
// с внешней функцией сравнения CompareSArray
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Rtmp: переменная, используемая при перестановках
// noswap: значение true показывает, что при проходе
//         не было перестановок
var i, j, k, N1, N2: integer;
    Rtmp: string;
    noswap: boolean;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре Bubble2 :' +
              #13'не задан массив строк');
     exit;
   end;
 N2 := High(M[0]);
 for i:=0 to N1-1 do begin
  noswap := true;
  for j:=N1-1 downto i do
  if CompareSArray(M[j], M[j+1])
    then begin
      for k:=0 to N2 do begin
       // Перестановка строк j и j+1
       Rtmp := M[j+1,k];
       M[j+1,k] := M[j,k];
       M[j,k] := Rtmp;
      end;
      noswap := false;
     end;
  if(noswap) then exit;
 end;
end;

procedure Bubble2(var M: TArrayI2);
// Пузырьковая сортировка двумерного массива M
// целых чисел с внешней функцией сравнения CompareIArray
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Rtmp: переменная, используемая при перестановках
// noswap: значение true показывает, что при проходе
//         не было перестановок
var i, j, k, N1, N2, Rtmp: integer;
    noswap: boolean;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре Bubble2 :' +
              #13'не задан массив целых чисел');
     exit;
   end;
 N2 := High(M[0]);
 for i:=0 to N1-1 do begin
  noswap := true;
  for j:=N1-1 downto i do
  if CompareIArray(M[j], M[j+1])
    then begin
      for k:=0 to N2 do begin
       // Перестановка строк j и j+1
       Rtmp := M[j+1,k];
       M[j+1,k] := M[j,k];
       M[j,k] := Rtmp;
      end;
      noswap := false;
     end;
  if(noswap) then exit;
 end;
end;

procedure Bubble2(var M: TArrayR2);
// Пузырьковая сортировка двумерного массива M
// действительных чисел  с внешней функцией сравнения CompareRArray
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Rtmp: переменная, используемая при перестановках
// noswap: значение true показывает, что при проходе
//         не было перестановок
var i, j, k, N1, N2: integer;
    Rtmp: real;
    noswap: boolean;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре Bubble2 :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
 N2 := High(M[0]);
 for i:=0 to N1-1 do begin
  noswap := true;
  for j:=N1-1 downto i do
  if CompareRArray(M[j], M[j+1])
    then begin
      for k:=0 to N2 do begin
       // Перестановка строк j и j+1
       Rtmp := M[j+1,k];
       M[j+1,k] := M[j,k];
       M[j,k] := Rtmp;
      end;
      noswap := false;
     end;
  if(noswap) then exit;
 end;
end;

procedure Bubble2(var M: TArrayS2; Compare: TCompareSArray);
// Пузырьковая сортировка двумерного массива строк M
// с функцией сравнения Compare
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Rtmp: переменная, используемая при перестановках
// noswap: значение true показывает, что при проходе
//         не было перестановок
var i, j, k, N1, N2: integer;
    Rtmp: string;
    noswap: boolean;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре Bubble2 :' +
              #13'не задан массив строк');
     exit;
   end;
 N2 := High(M[0]);
 for i:=0 to N1-1 do begin
  noswap := true;
  for j:=N1-1 downto i do
  if Compare(M[j], M[j+1])
    then begin
      for k:=0 to N2 do begin
       // Перестановка строк j и j+1
       Rtmp := M[j+1,k];
       M[j+1,k] := M[j,k];
       M[j,k] := Rtmp;
      end;
      noswap := false;
     end;
  if(noswap) then exit;
 end;
end;

procedure Bubble2(var M: TArrayI2; Compare: TCompareIArray);
// Пузырьковая сортировка двумерного массива M
// целых чисел с функцией сравнения Compare
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Rtmp: переменная, используемая при перестановках
// noswap: значение true показывает, что при проходе
//         не было перестановок
var i, j, k, N1, N2, Rtmp: integer;
    noswap: boolean;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре Bubble2 :' +
              #13'не задан массив целых чисел');
     exit;
   end;
 N2 := High(M[0]);
 for i:=0 to N1-1 do begin
  noswap := true;
  for j:=N1-1 downto i do
  if Compare(M[j], M[j+1])
    then begin
      for k:=0 to N2 do begin
       // Перестановка строк j и j+1
       Rtmp := M[j+1,k];
       M[j+1,k] := M[j,k];
       M[j,k] := Rtmp;
      end;
      noswap := false;
     end;
  if(noswap) then exit;
 end;
end;

procedure Bubble2(var M: TArrayR2; Compare: TCompareRArray);
// Пузырьковая сортировка двумерного массива M
// действительных чисел с функцией сравнения Compare
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Rtmp: переменная, используемая при перестановках
// noswap: значение true показывает, что при проходе
//         не было перестановок
var i, j, k, N1, N2: integer;
    Rtmp: real;
    noswap: boolean;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре Bubble2 :' +
              #13'не задан массив целых чисел');
     exit;
   end;
 N2 := High(M[0]);
 for i:=0 to N1-1 do begin
  noswap := true;
  for j:=N1-1 downto i do
  if Compare(M[j], M[j+1])
    then begin
      for k:=0 to N2 do begin
       // Перестановка строк j и j+1
       Rtmp := M[j+1,k];
       M[j+1,k] := M[j,k];
       M[j,k] := Rtmp;
      end;
      noswap := false;
     end;
  if(noswap) then exit;
 end;
end;

procedure StepSort(var M: TArrayS1; New: string);
// Добавление в сортированный массив M нового элемента New
// i: счетчик циклов
// N: максимальный индекс массива
var i, N: integer;
begin
 N := High(M);
 SetLength(M,N+2);
 for i:=N downto 0 do
  if (AnsiCompareText(New, M[i]) < 0)
    then M[i+1] := M[i]
    else begin
     M[i+1] := New;
     exit;
    end;
 M[0] := New;
end;

procedure StepSort(var M: TArrayR1; New: real);
// Добавление в сортированный массив M нового элемента New
// i: счетчик циклов
// N: максимальный индекс массива
var i, N: integer;
begin
 N := High(M);
 SetLength(M,N+2);
 for i:=N downto 0 do
  if New < M[i]
    then M[i+1] := M[i]
    else begin
     M[i+1] := New;
     exit;
    end;
 M[0] := New;
end;

procedure StepSort(var M: TArrayI1; New: integer);
// Добавление в сортированный массив M нового элемента New
// i: счетчик циклов
// N: максимальный индекс массива
var i, N: integer;
begin
 N := High(M);
 SetLength(M,N+2);
 for i:=N downto 0 do
  if New < M[i]
    then M[i+1] := M[i]
    else begin
     M[i+1] := New;
     exit;
    end;
 M[0] := New;
end;

procedure MinSortStr(var M: array of string);
// Сортировка массива строк
//  с выброром минимального элемента
// i, j: счетчики циклов
// N: максимальный индекс массива
// Imin: индекс минимального элемента
// Rtmp: переменная, используемая при перестановках
var i, j, N, Imin: integer;
    Rtmp: string;
begin
 N := High(M);
 for i:=0 to N-1 do begin
  Imin := N;
  for j:=N-1 downto i do
   if(AnsiCompareText(M[j],M[Imin]) <= 0)
     then Imin := j;
  if (i < Imin)
    then begin
     // Перестановка элементов M[i] и M[Imin]
     Rtmp := M[Imin];
     M[Imin] := M[i];
     M[i] := Rtmp;
    end;
 end;
end;

procedure MinSortInt(var M: array of integer);
// Сортировка массива целых чисел
//  с выброром минимального элемента
// i, j: счетчики циклов
// N: максимальный индекс массива
// Imin: индекс минимального элемента
// Rtmp: переменная, используемая при перестановках
var i, j, N, Imin, Rtmp: integer;
begin
 N := High(M);
 for i:=0 to N-1 do begin
  Imin := N;
  for j:=N-1 downto i do
   if(M[j] <= M[Imin])
     then Imin := j;
  if (i < Imin)
    then begin
     // Перестановка элементов M[i] и M[Imin]
     Rtmp := M[Imin];
     M[Imin] := M[i];
     M[i] := Rtmp;
    end;
 end;
end;

procedure MinSortReal(var M: array of real);
// Cортировка массива действительных чисел
//  с выброром минимального элемента
// i, j: счетчики циклов
// N: максимальный индекс массива
// Imin: индекс минимального элемента
// Rtmp: переменная, используемая при перестановках
var i, j, N,  Imin: integer;
    Rtmp: real;
begin
 N := High(M);
 for i:=0 to N-1 do begin
  Imin := N;
  for j:=N-1 downto i do
   if(M[j] <= M[Imin])
     then Imin := j;
  if (i < Imin)
    then begin
     // Перестановка элементов M[i] и M[Imin]
     Rtmp := M[Imin];
     M[Imin] := M[i];
     M[i] := Rtmp;
    end;
 end;
end;

procedure MinSort2(var M: TArrayS2; Ind:word); overload;
// Сортировка двумерного массива M строк
// с выброром минимального элемента
// Ind - индекс элемента,
// по которому ведется сортировка
// i, j: счетчики циклов
// k: счетчик цикла по элементам
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Imin: индекс строки, признанной "минимальной"
// Rtmp: переменная, используемая при перестановках
var i, j, k, N1, N2, Imin: integer;
    Rtmp: string;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре MinSort2 :' +
              #13'не задан массив строк');
     exit;
   end;
 N2 := High(M[0]);
 if(Ind > N2)
   then begin
     Messages('Ошибка в процедуре MinSort2 :' +
              #13'индекс ' + IntToStr(Ind)+
              ' превышает максимальный индекс массива ' +
              IntToStr(N2));
     exit;
   end;
 for i:=0 to N1-1 do begin
  Imin := N1;
  for j:=N1-1 downto i do
  if (AnsiCompareText(M[j, Ind],M[Imin, Ind]) <= 0)
    then Imin := j;
  if (i < Imin)
    then for k:=0 to N2 do begin
     // Перестановка строк i и Imin
     Rtmp := M[Imin,k];
      M[Imin,k] := M[i,k];
      M[i,k] := Rtmp;
     end;
 end;
end;

procedure MinSort2(var M: TArrayI2; Ind:word); overload;
// Сортировка двумерного массива M
// целых чисел с выброром минимального элемента
// Ind - индекс элемента строки,
// по которому ведется сортировка
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Imin: индекс строки, признанной "минимальной"
// Rtmp: переменная, используемая при перестановках
var i, j, k, N1, N2, Imin, Rtmp: integer;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре MinSort2 :' +
              #13'не задан массив целых чисел');
     exit;
   end;
 N2 := High(M[0]);
 if(Ind > N2)
   then begin
     Messages('Ошибка в процедуре MinSort2 :' +
              #13'индекс ' + IntToStr(Ind)+
              ' превышает максимальный индекс массива ' +
              IntToStr(N2));
     exit;
   end;
 for i:=0 to N1-1 do begin
  Imin := N1;
  for j:=N1-1 downto i do
  if (M[j, Ind] <= M[Imin, Ind])
    then Imin := j;
  if (i < Imin)
    then for k:=0 to N2 do begin
     // Перестановка строк i и Imin
     Rtmp := M[Imin,k];
      M[Imin,k] := M[i,k];
      M[i,k] := Rtmp;
     end;
 end;
end;

procedure MinSort2(var M: TArrayR2; Ind:word); overload;
// Сортировка двумерного массива M
// действительных чисел с выброром минимального элемента
// Ind - индекс элемента строки,
// по которому ведется сортировка
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Imin: индекс строки, признанной "минимальной"
// Rtmp: переменная, используемая при перестановках
var i, j, k, N1, N2, Imin: integer;
    Rtmp: real;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре MinSort2 :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
 N2 := High(M[0]);
 if(Ind > N2)
   then begin
     Messages('Ошибка в процедуре MinSort2 :' +
              #13'индекс ' + IntToStr(Ind)+
              ' превышает максимальный индекс массива ' +
              IntToStr(N2));
     exit;
   end;
 for i:=0 to N1-1 do begin
  Imin := N1;
  for j:=N1-1 downto i do
  if (M[j, Ind] <= M[Imin, Ind])
    then Imin := j;
  if (i < Imin)
    then for k:=0 to N2 do begin
     // Перестановка строк i и Imin
     Rtmp := M[Imin,k];
      M[Imin,k] := M[i,k];
      M[i,k] := Rtmp;
     end;
 end;
end;

procedure MinSort2(var M: TArrayI2); overload;
// Сортировка двумерного массива M
// целых чисел с выброром минимального элемента
// с внешней функцией сравнения CompareIArray
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Imin: индекс строки, признанной "минимальной"
// Rtmp: переменная, используемая при перестановках
var i, j, k, N1, N2, Imin, Rtmp: integer;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре MinSort2 :' +
              #13'не задан массив целых чисел');
     exit;
   end;
 N2 := High(M[0]);
 for i:=0 to N1-1 do begin
  Imin := N1;
  for j:=N1-1 downto i do
  if CompareIArray(M[Imin], M[j])
    then Imin := j;
  if (i < Imin)
    then for k:=0 to N2 do begin
     // Перестановка строк i и Imin
     Rtmp := M[Imin,k];
     M[Imin,k] := M[i,k];
     M[i,k] := Rtmp;
    end;
 end;
end;

procedure MinSort2(var M: TArrayS2); overload;
// Сортировка двумерного массива M строк
// с выброром минимального элемента
// с внешней функцией сравнения CompareSArray
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Imin: индекс строки, признанной "минимальной"
// Rtmp: переменная, используемая при перестановках
var i, j, k, N1, N2, Imin: integer;
    Rtmp: string;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре MinSort2 :' +
              #13'не задан массив строк');
     exit;
   end;
 N2 := High(M[0]);
 for i:=0 to N1-1 do begin
  Imin := N1;
  for j:=N1-1 downto i do
  if CompareSArray(M[Imin], M[j])
    then Imin := j;
  if (i < Imin)
    then for k:=0 to N2 do begin
     // Перестановка строк i и Imin
     Rtmp := M[Imin,k];
     M[Imin,k] := M[i,k];
     M[i,k] := Rtmp;
    end;
 end;
end;

procedure MinSort2(var M: TArrayR2); overload;
// Сортировка двумерного массива M
// действительных чисел с выброром минимального элемента
// с внешней функцией сравнения CompareRArray
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Imin: индекс строки, признанной "минимальной"
// Rtmp: переменная, используемая при перестановках
var i, j, k, N1, N2, Imin: integer;
     Rtmp: real;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре MinSort2 :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
 N2 := High(M[0]);
 for i:=0 to N1-1 do begin
  Imin := N1;
  for j:=N1-1 downto i do
  if CompareRArray(M[Imin], M[j])
    then Imin := j;
  if (i < Imin)
    then for k:=0 to N2 do begin
     // Перестановка строк i и Imin
     Rtmp := M[Imin,k];
      M[Imin,k] := M[i,k];
      M[i,k] := Rtmp;
     end;
 end;
end;

procedure MinSort2(var M: TArrayS2;
                   Compare: TCompareSArray); overload;
// Сортировка двумерного массива M строк
// с выброром минимального элемента
// Compare - функция сравнения
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Imin: индекс строки, признанной "минимальной"
// Rtmp: переменная, используемая при перестановках
var i, j, k, N1, N2, Imin: integer;
    Rtmp: string;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре MinSort2 :' +
              #13'не задан массив строк');
     exit;
   end;
 N2 := High(M[0]);
 for i:=0 to N1-1 do begin
  Imin := N1;
  for j:=N1-1 downto i do
  if Compare(M[Imin], M[j])
    then Imin := j;
  if (i < Imin)
    then for k:=0 to N2 do begin
     // Перестановка строк i и Imin
     Rtmp := M[Imin,k];
      M[Imin,k] := M[i,k];
      M[i,k] := Rtmp;
     end;
 end;
end;

procedure MinSort2(var M: TArrayI2;
                   Compare: TCompareIArray); overload;
// Сортировка двумерного массива M
// целых чисел с выброром минимального элемента
// Compare - функция сравнения
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Imin: индекс строки, признанной "минимальной"
// Rtmp: переменная, используемая при перестановках
var i, j, k, N1, N2, Imin, Rtmp: integer;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре MinSort2 :' +
              #13'не задан массив целых чисел');
     exit;
   end;
 N2 := High(M[0]);
 for i:=0 to N1-1 do begin
  Imin := N1;
  for j:=N1-1 downto i do
  if Compare(M[Imin], M[j])
    then Imin := j;
  if (i < Imin)
    then for k:=0 to N2 do begin
     // Перестановка строк i и Imin
     Rtmp := M[Imin,k];
      M[Imin,k] := M[i,k];
      M[i,k] := Rtmp;
     end;
 end;
end;

procedure MinSort2(var M: TArrayR2;
                   Compare: TCompareRArray); overload;
// Сортировка двумерного массива M
// действительных чисел с выброром минимального элемента
// Compare - функция сравнения
// Ind - индекс элемента строки,
// по которому ведется сортировка
// i, j: счетчики циклов
// k: счетчик цикла по элементам строки
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Imin: индекс строки, признанной "минимальной"
// Rtmp: переменная, используемая при перестановках
var i, j, k, N1, N2, Imin: integer;
     Rtmp: real;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре MinSort2 :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
 N2 := High(M[0]);
 for i:=0 to N1-1 do begin
  Imin := N1;
  for j:=N1-1 downto i do
  if Compare(M[Imin], M[j])
    then Imin := j;
  if (i < Imin)
    then for k:=0 to N2 do begin
     // Перестановка строк i и Imin
     Rtmp := M[Imin,k];
      M[Imin,k] := M[i,k];
      M[i,k] := Rtmp;
     end;
 end;
end;

function Index2(const M: TArrayS2; Ind:word): TArrayI1; overload;
// Построение индекса двумерного массива M строк
// сортировкой с выброром минимального элемента
// Возвращают индексный массив
// Ind - индекс элемента,
//       по которому ведется сортировка
// i, j: счетчики циклов
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Imin: индекс индексного массива,
//       соответствующий минимальному элементу
// Rtmp: переменная, используемая при перестановках
var i, j, N1, N2, Imin, Rtmp: integer;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре Index2 :' +
              #13'не задан массив строк');
     exit;
   end;
 N2 := High(M[0]);
 if(Ind > N2)
   then begin
     Messages('Ошибка в процедуре Index2 :' +
              #13'индекс ' + IntToStr(Ind)+
              ' превышает максимальный индекс массива ' +
              IntToStr(N2));
     exit;
   end;
// Начальное заполнение индексного массива
 SetLength(Result, N1+1);
 for i:=0 to N1 do
   Result[i] := i;
// Циклы сортировки
 for i:=0 to N1-1 do begin
  Imin := N1;
  for j:=N1-1 downto i do
  if (AnsiCompareText(M[Result[j], Result[Ind]],M[Result[Imin], Result[Ind]])
      <0)
    then Imin := j;
  if (i < Imin)
    then begin
     // Перестановка в индексном массиве элементов i и Imin
     Rtmp := Result[Imin];
     Result[Imin] := Result[i];
     Result[i] := Rtmp;
    end;
 end;
end;

function Index2(const M: TArrayI2; Ind:word): TArrayI1; overload;
// Построение индекса двумерного массива M
// целых чисел сортировкой с выброром минимального элемента
// Возвращают индексный массив
// Ind - индекс элемента строки,
//       по которому ведется сортировка
// i, j: счетчики циклов
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Imin: индекс индексного массива,
//       соответствующий минимальному элементу
// Rtmp: переменная, используемая при перестановках
var i, j, N1, N2, Imin, Rtmp: integer;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре Index2 :' +
              #13'не задан массив целых чисел');
     exit;
   end;
 N2 := High(M[0]);
 if(Ind > N2)
   then begin
     Messages('Ошибка в процедуре Index2 :' +
              #13'индекс ' + IntToStr(Ind)+
              ' превышает максимальный индекс массива ' +
              IntToStr(N2));
     exit;
   end;
// Начальное заполнение индексного массива
 SetLength(Result, N1+1);
 for i:=0 to N1 do
   Result[i] := i;
// Циклы сортировки
 for i:=0 to N1-1 do begin
  Imin := N1;
  for j:=N1-1 downto i do
  if (M[Result[j], Result[Ind]] < M[Result[Imin], Result[Ind]])
    then Imin := j;
  if (i < Imin)
    then begin
     // Перестановка в индексном массиве элементов i и Imin
     Rtmp := Result[Imin];
     Result[Imin] := Result[i];
     Result[i] := Rtmp;
    end;
 end;
end;

function Index2(const M: TArrayR2; Ind:word): TArrayI1; overload;
// Построение индекса двумерного массива M
// действительных чисел
// сортировкой с выброром минимального элемента
// Возвращают индексный массив
// Ind - индекс элемента строки,
//       по которому ведется сортировка
// i, j: счетчики циклов
// N1: максимальный индекс строки массива
// N2: максимальный индекс элемента строки
// Imin: индекс индексного массива,
//       соответствующий минимальному элементу
// Rtmp: переменная, используемая при перестановках
var i, j, N1, N2, Imin, Rtmp: integer;
begin
 ErrorArray := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре Index2 :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
 N2 := High(M[0]);
 if(Ind > N2)
   then begin
     Messages('Ошибка в процедуре Index2 :' +
              #13'индекс ' + IntToStr(Ind)+
              ' превышает максимальный индекс массива ' +
              IntToStr(N2));
     exit;
   end;
// Начальное заполнение индексного массива
 SetLength(Result, N1+1);
 for i:=0 to N1 do
   Result[i] := i;
// Циклы сортировки
 for i:=0 to N1-1 do begin
  Imin := N1;
  for j:=N1-1 downto i do
  if (M[Result[j], Result[Ind]] < M[Result[Imin], Result[Ind]])
    then Imin := j;
  if (i < Imin)
    then begin
     // Перестановка в индексном массиве элементов i и Imin
     Rtmp := Result[Imin];
     Result[Imin] := Result[i];
     Result[i] := Rtmp;
    end;
 end;
end;

function Index2(const M: TArrayS2): TArrayI1; overload;
// Построение индекса двумерного массива M строк
// с выброром минимального элемента
// с внешней функцией сравнения CompareSArray
// Возвращает индексный массив
// i, j: счетчики циклов
// N: максимальный индекс строки массива
// Imin: индекс индексного массива,
//       соответствующий минимальному элементу
// Rtmp: переменная, используемая при перестановках
var i, j, N, Imin, Rtmp: integer;
begin
 ErrorArray := false;
 N := High(M);
 if(N < 0)
   then begin
     Messages('Ошибка в процедуре Index2 :' +
              #13'не задан массив строк');
     exit;
   end;
// Начальное заполнение индексного массива
 SetLength(Result, N+1);
 for i:=0 to N do
   Result[i] := i;
// Циклы сортировки
 for i:=0 to N-1 do begin
  Imin := N;
  for j:=N-1 downto i do
  if CompareSArray(M[Result[Imin]], M[Result[j]])
    then Imin := j;
  if (i < Imin)
    then begin
     // Перестановка в индексном массиве элементов i и Imin
     Rtmp := Result[Imin];
     Result[Imin] := Result[i];
     Result[i] := Rtmp;
    end;
 end;
end;

function Index2(const M: TArrayI2): TArrayI1; overload;
// Построение индекса двумерного массива M
// целых чисел с выброром минимального элемента
// с внешней функцией сравнения CompareIArray
// Возвращает индексный массив
// i, j: счетчики циклов
// N: максимальный индекс строки массива
// Imin: индекс индексного массива,
//       соответствующий минимальному элементу
// Rtmp: переменная, используемая при перестановках
var i, j, N, Imin, Rtmp: integer;
begin
 ErrorArray := false;
 N := High(M);
 if(N < 0)
   then begin
     Messages('Ошибка в процедуре Index2 :' +
              #13'не задан массив целых чисел');
     exit;
   end;
// Начальное заполнение индексного массива
 SetLength(Result, N+1);
 for i:=0 to N do
   Result[i] := i;
// Циклы сортировки
 for i:=0 to N-1 do begin
  Imin := N;
  for j:=N-1 downto i do
  if CompareIArray(M[Result[Imin]], M[Result[j]])
    then Imin := j;
  if (i < Imin)
    then begin
     // Перестановка в индексном массиве элементов i и Imin
     Rtmp := Result[Imin];
     Result[Imin] := Result[i];
     Result[i] := Rtmp;
    end;
 end;
end;

function Index2(const M: TArrayR2): TArrayI1; overload;
// Построение индекса двумерного массива M
// действительных чисел с выброром минимального элемента
// с внешней функцией сравнения CompareIArray
// Возвращает индексный массив
// i, j: счетчики циклов
// N: максимальный индекс строки массива
// Imin: индекс индексного массива,
//       соответствующий минимальному элементу
// Rtmp: переменная, используемая при перестановках
var i, j, N, Imin, Rtmp: integer;
begin
 ErrorArray := false;
 N := High(M);
 if(N < 0)
   then begin
     Messages('Ошибка в процедуре Index2 :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
// Начальное заполнение индексного массива
 SetLength(Result, N+1);
 for i:=0 to N do
   Result[i] := i;
// Циклы сортировки
 for i:=0 to N-1 do begin
  Imin := N;
  for j:=N-1 downto i do
  if CompareRArray(M[Result[Imin]], M[Result[j]])
    then Imin := j;
  if (i < Imin)
    then begin
     // Перестановка в индексном массиве элементов i и Imin
     Rtmp := Result[Imin];
     Result[Imin] := Result[i];
     Result[i] := Rtmp;
    end;
 end;
end;

function Index2(const M: TArrayS2;
                Compare: TCompareSArray): TArrayI1; overload;
// Построение индекса двумерного массива M строк
// с выброром минимального элемента
// Compare - функция сравнения
// Возвращает индексный массив
// i, j: счетчики циклов
// N: максимальный индекс строки массива
// Imin: индекс индексного массива,
//       соответствующий минимальному элементу
// Rtmp: переменная, используемая при перестановках
var i, j, N, Imin, Rtmp: integer;
begin
 ErrorArray := false;
 N := High(M);
 if(N < 0)
   then begin
     Messages('Ошибка в процедуре Index2 :' +
              #13'не задан массив строк');
     exit;
   end;
// Начальное заполнение индексного массива
 SetLength(Result, N+1);
 for i:=0 to N do
   Result[i] := i;
// Циклы сортировки
 for i:=0 to N-1 do begin
  Imin := N;
  for j:=N-1 downto i do
  if Compare(M[Result[Imin]], M[Result[j]])
    then Imin := j;
  if (i < Imin)
    then begin
     // Перестановка в индексном массиве элементов i и Imin
     Rtmp := Result[Imin];
     Result[Imin] := Result[i];
     Result[i] := Rtmp;
    end;
 end;
end;

function Index2(const M: TArrayI2;
                Compare: TCompareIArray): TArrayI1; overload;
// Построение индекса двумерного массива M
// целых чисел с выброром минимального элемента
// Compare - функция сравнения
// Возвращает индексный массив
// i, j: счетчики циклов
// N: максимальный индекс строки массива
// Imin: индекс индексного массива,
//       соответствующий минимальному элементу
// Rtmp: переменная, используемая при перестановках
var i, j, N, Imin, Rtmp: integer;
begin
 ErrorArray := false;
 N := High(M);
 if(N < 0)
   then begin
     Messages('Ошибка в процедуре Index2 :' +
              #13'не задан массив целых чисел');
     exit;
   end;
// Начальное заполнение индексного массива
 SetLength(Result, N+1);
 for i:=0 to N do
   Result[i] := i;
// Циклы сортировки
 for i:=0 to N-1 do begin
  Imin := N;
  for j:=N-1 downto i do
  if Compare(M[Result[Imin]], M[Result[j]])
    then Imin := j;
  if (i < Imin)
    then begin
     // Перестановка в индексном массиве элементов i и Imin
     Rtmp := Result[Imin];
     Result[Imin] := Result[i];
     Result[i] := Rtmp;
    end;
 end;
end;

function Index2(const M: TArrayR2;
                Compare: TCompareRArray): TArrayI1; overload;
// Построение индекса двумерного массива M
// действительных чисел с выброром минимального элемента
// Compare - функция сравнения
// Возвращает индексный массив
// i, j: счетчики циклов
// N: максимальный индекс строки массива
// Imin: индекс индексного массива,
//       соответствующий минимальному элементу
// Rtmp: переменная, используемая при перестановках
var i, j, N, Imin, Rtmp: integer;
begin
 ErrorArray := false;
 N := High(M);
 if(N < 0)
   then begin
     Messages('Ошибка в процедуре Index2 :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
// Начальное заполнение индексного массива
 SetLength(Result, N+1);
 for i:=0 to N do
   Result[i] := i;
// Циклы сортировки
 for i:=0 to N-1 do begin
  Imin := N;
  for j:=N-1 downto i do
  if Compare(M[Result[Imin]], M[Result[j]])
    then Imin := j;
  if (i < Imin)
    then begin
     // Перестановка в индексном массиве элементов i и Imin
     Rtmp := Result[Imin];
     Result[Imin] := Result[i];
     Result[i] := Rtmp;
    end;
 end;
end;

// Вспомогательные функции для поиска

function DiffS(S1, S2:string): integer;
// Возвращает число первых символов,
// совпадающих в строках S1 и S2
// без учета регистра
var L: integer;
begin
 L := Min(Length(S1), Length(S2));
 for Result:=1 to L do
  if AnsiUpperCase(S1[Result]) <> AnsiUpperCase(S2[Result])
   then break;
 Dec(Result);  
end;

function ResultS(const M: TArrayS2; N, i: integer): TArrayS1;
// Возвращает динамический массив строк,
// содержащий в первом элементе значение i,
// а в остальных - значения элементов
// массива строк M размером N 
var j:integer;
begin
 SetLength(Result, N+2);
 for j:= 0 to N do
  Result[j+1] := M[i,j];
 Result[0] := IntToStr(i);
end;

function ResultI(const M: TArrayI2; N, i: integer): TArrayI1;
// Возвращает динамический массив целых чисел,
// содержащий в первом элементе значение i,
// а в остальных - значения элементов
// массива целых чисел M размером N 
var j:integer;
begin
 SetLength(Result, N+2);
 for j:= 0 to N do
  Result[j+1] := M[i,j];
 Result[0] := i;
end;

function ResultR(const M: TArrayR2; N, i: integer): TArrayR1;
// Возвращает динамический массив действительных чисел,
// содержащий в первом элементе значение i,
// а в остальных - значения элементов
// массива действительных чисел M размером N 
var j:integer;
begin
 SetLength(Result, N+2);
 for j:= 0 to N do
  Result[j+1] := M[i,j];
 Result[0] := i;
end;

// Функции для поиска

function FindS(const M: TArrayS2; X:string; Ind: integer;
                   out Row: TArrayS1): boolean;
// Поиск значения X в элементах строк с индексом Ind
// несортированного двумерного массива строк M
// Row - найденная строка, ее первый элемент - индекс строки
// Если строка не найдена, возвращается false
var i, N1, N2:integer;
begin
 Result := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре FindS :' +
              #13'не задан массив строк');
     exit;
   end;
 N2 := High(M[0]);
 SetLength(Row, N2+2);
 for i:=0 to N1 do
  if(AnsiCompareText(M[i,Ind],X) = 0)
    then begin
     Row := ResultS(M, N2, i);
     Result := true;
     break;
    end;
end;

function FindI(const M: TArrayI2; X, Ind: integer;
                   out Row: TArrayI1): boolean;
// Поиск значения X в элементах строк с индексом Ind
// несортированного двумерного массива целых чисел M
// Row - найденная строка, ее первый элемент - индекс строки
// Если строка не найдена, возвращается false
var i, N1, N2:integer;
begin
 Result := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре FindI :' +
              #13'не задан массив целых чисел');
     exit;
   end;
 N2 := High(M[0]);
 SetLength(Row, N2+2);
 for i:=0 to N1 do
  if(M[i,Ind] = X)
    then begin
     Row := ResultI(M, N2, i);
     Result := true;
     break;
    end;
end;

function FindR(const M: TArrayR2; X: real; Ind:integer;
                   out Row: TArrayR1): boolean;
// Поиск значения X в элементах строк с индексом Ind
// несортированного двумерного массива действительных чисел M
// Row - найденная строка, ее первый элемент - индекс строки
// Если строка не найдена, возвращается false
var i, N1, N2:integer;
begin
 Result := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре FindR :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
 N2 := High(M[0]);
 SetLength(Row, N2+2);
 for i:=0 to N1 do
  if(M[i,Ind] = X)
    then begin
     Row := ResultR(M, N2, i);
     Result := true;
     break;
    end;
end;

procedure FindNearS(const M: TArrayS2; X:string;
                    Ind: integer; out Row: TArrayS1);
// Поиск ближайшего соответствия заданного значания X
// и элемента с индексом Ind
// строки несортированного двумерного массива строк M
// Row - найденная строка, первый ее элемент - индекс строки
var i, N1, N2:integer;
    Indmin, Rmin, Rtmp, LX: integer;
begin
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре FindNearS :' +
              #13'не задан массив строк');
     exit;
   end;
 N2 := High(M[0]);
 LX := Length(X);
 SetLength(Row, N2+2);
 Rmin := MaxInt;
 for i:=0 to N1 do begin
  Rtmp := LX - DiffS(X,M[i,Ind]);
  if (Rtmp = 0)
    then begin
     Row := ResultS(M, N2, i);
     exit;
    end;
  if(Rtmp < Rmin)
   then begin
    Rmin := Rtmp;
    Indmin := i;
   end;
 end;
 Row := ResultS(M, N2, Indmin);
end;

procedure FindNearI(const M: TArrayI2; X, Ind: integer;
                   out Row: TArrayI1);
// Поиск ближайшего соответствия заданного значания X
// и элемента с индексом Ind
// строки несортированного двумерного массива целых чисел M
// Row - найденная строка, первый ее элемент - индекс строки
var i, N1, N2:integer;
    Indmin, Rmin, Rtmp: integer;
begin
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре FindNearI :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
 N2 := High(M[0]);
 SetLength(Row, N2+2);
 Rmin := MaxInt;
 for i:=0 to N1 do begin
  Rtmp := Abs(M[i,Ind] - X);
  if (Rtmp = 0)
    then begin
     Row := ResultI(M, N2, i);
     exit;
    end;
  if(Rtmp < Rmin)
   then begin
    Rmin := Rtmp;
    Indmin := i;
   end;
 end;
 Row := ResultI(M, N2, Indmin);
end;

procedure FindNearR(const M: TArrayR2; X: real; Ind:integer;
                   out Row: TArrayR1);
// Поиск ближайшего соответствия заданного значания X
// и элемента с индексом Ind
// строки несортированного массива действительных чисел M
// Row - найденная строка, первый ее элемент - индекс строки
var i, N1, N2:integer;
    Indmin: integer;
    Rmin, Rtmp: real;
begin
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре FindNearR :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
 N2 := High(M[0]);
 SetLength(Row, N2+2);
 Rmin := 1.7E308;
 for i:=0 to N1 do begin
  Rtmp := Abs(M[i,Ind] - X);
  if (Rtmp = 0)
    then begin
     Row := ResultR(M, N2, i);
     exit;
    end;
  if(Rtmp < Rmin)
   then begin
    Rmin := Rtmp;
    Indmin := i;
   end;
 end;
 Row := ResultR(M, N2, Indmin);
end;

procedure InterpR(const M: TArrayR2; X: real; Ind: integer;
                   out Row: TArrayR1);
// Поиск заданного значания X в элементах с индексом Ind
// строки несортированного массива M
// с линейной интерполяцией
// Row - результирующая строка
// Если X > максимального или < минимального элемента,
// то возвращается ближайшая строка
var i, j, N1, N2, IHi, ILo:integer;
    Rtmp, RHi, RLo, k: real;
begin
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре InterpR :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
 N2 := High(M[0]);
 SetLength(Row, N2+1);
 RLo := -1.7E308;
 RHi := 1.7E308;
 IHi := -1;
 ILo := -1;
 for i:=0 to N1 do begin
  Rtmp := M[i,Ind] - X;
  case Sign(Rtmp) of
   0: begin
       for j:=0 to N2 do
        Row[j] := M[i,j];
       exit;
      end;
   1: if (Rtmp < RHi)
       then begin
        RHi := Rtmp;
        IHi := i;
       end;
  -1: if (Rtmp > RLo)
       then begin
        RLo := Rtmp;
        ILo := i;
       end;
  end;
 end;

 if (ILo > -1) and (IHi > -1)
  // Интерполяция
  then begin
   k:= (X - M[ILo,Ind]) / (M[IHi,Ind] - M[ILo,Ind]);
   for j:=0 to N2 do
    Row[j] := M[ILo,j] + (M[IHi,j] - M[ILo,j]) * k;
  end
  else begin
   if (IHi = -1)
     then i := ILo
     else i := IHi;
   for j:=0 to N2 do Row[j] := M[i,j];
  end;
end;

function FindSSort(const M: TArrayS2; X: string;
                   Ind: integer; out Row: TArrayS1): boolean;
// Поиск методом дихотомии
// точного совпадения заданного значания X
// в элементах строк с индексом Ind
// сортированного массива строк M
// Row - найденная строка, ее первый элемент - индекс строки
// Если строка не найдена, возвращается false
var imin, imax, i, icomp, N1, N2:integer;
begin
 Result := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре FindSSort :' +
              #13'не задан массив строк');
     exit;
   end;
 N2 := High(M[0]);
 SetLength(Row, N2+2);
 imin :=-1;
 imax := N1+1;
 repeat
  i := (imin + imax) div 2;
  icomp := AnsiCompareText(M[i,Ind],X);
  if(icomp = 0)
    then begin
     Row := ResultS(M, N2, i);
     Result := true;
     break;
    end;
  if (icomp > 0)
   then imax := i
   else imin := i;
  if(imax - imin = 1) then break;
 until false;
end;

function FindISort(const M: TArrayI2; X, Ind: integer;
                   out Row: TArrayI1): boolean;
// Поиск методом дихотомии
// точного совпадения заданного значания X
// в элементах строк с индексом Ind
// сортированного массива целых чисел M
// Row - найденная строка, ее первый элемент - индекс строки
// Если строка не найдена, возвращается false
var imin, imax, i, N1, N2:integer;
begin
 Result := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре FindISort :' +
              #13'не задан массив целых чисел');
     exit;
   end;
 N2 := High(M[0]);
 SetLength(Row, N2+2);
 imin :=-1;
 imax := N1+1;
 repeat
  i := (imin + imax) div 2;
  if(M[i,Ind] = X)
    then begin
     Row := ResultI(M, N2, i);
     Result := true;
     break;
    end;
  if(M[i,Ind] > X)
   then imax := i
   else imin := i;
  if(imax - imin = 1) then break;
 until false;
end;

function FindRSort(const M: TArrayR2; X: real; Ind:integer;
                   out Row: TArrayR1): boolean;
// Поиск методом дихотомии
// точного совпадения заданного значания X
// в элементах строк с индексом Ind
// сортированного массива действительных чисел M
// Row - найденная строка, ее первый элемент - индекс строки
// Если строка не найдена, возвращается false
var imin, imax, i, N1, N2:integer;
begin
 Result := false;
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре FindRSort :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
 N2 := High(M[0]);
 SetLength(Row, N2+2);
 imin :=-1;
 imax := N1+1;
 repeat
  i := (imin + imax) div 2;
  if(M[i,Ind] = X)
    then begin
     Row := ResultR(M, N2, i);
     Result := true;
     break;
    end;
  if(M[i,Ind] > X)
   then imax := i
   else imin := i;
  if(imax - imin = 1) then break;
 until false;
end;

procedure FindNearSSort(const M: TArrayS2; X: string;
                        Ind: integer; out Row: TArrayS1);
// Поиск ближайшего соответствия заданного значания X
// и элемента с индексом Ind
// строки сортированного массива строк M
// Row - найденная строка, первый ее элемент - индекс строки
var imin, imax, i, LX, N1, N2:integer;
    Indmin, Rmin: integer;
begin
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре FindNearSSort :' +
              #13'не задан массив строк');
     exit;
   end;
 N2 := High(M[0]);
 SetLength(Row, N2+2);
 LX := Length(X);
 imin :=-1;
 imax := N1+1;
 repeat
  i := (imin + imax) div 2;
  Rmin := LX - DiffS(X,M[i,Ind]);
  if(Rmin = 0)
    then begin
     Row := ResultS(M, N2, i);
     break;
    end;
  if(imax - imin = 1)
   then begin
     Indmin := i;
     if (imin >= 0) and (imin < i)
      then if(LX - DiffS(X,M[imin,Ind]) < Rmin)
       then begin
        Indmin := imin;
//        Rmin := LX - DiffS(X,M[imin,Ind]);
       end;
     if (imax <= N1) and (imax > i)
      then if(LX - DiffS(X,M[imax,Ind]) < Rmin)
       then Indmin := imax;
     Row := ResultS(M, N2, Indmin);
     break;
   end;
  if(AnsiCompareText(M[i,Ind],X) > 0)
   then imax := i
   else imin := i;
 until false;
end;

procedure FindNearISort(const M: TArrayI2; X, Ind: integer;
                   out Row: TArrayI1);
// Поиск ближайшего соответствия заданного значания X
// и элемента с индексом Ind
// строки сортированного массива целых чисел M
// Row - найденная строка, первый ее элемент - индекс строки
var imin, imax, i, N1, N2:integer;
    Indmin, Rmin: integer;
begin
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре FindNearISort :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
 N2 := High(M[0]);
 SetLength(Row, N2+2);
 imin :=-1;
 imax := N1+1;
 repeat
  i := (imin + imax) div 2;
  if(M[i,Ind] = X)
    then begin
     Row := ResultI(M, N2, i);
     break;
    end;
  if(M[i,Ind] > X)
   then imax := i
   else imin := i;
  if(imax - imin = 1)
   then begin
     Indmin := i;
     Rmin := Abs(X - M[i,Ind]);
     if (imin >= 0) and (imin < i)
      then if(Abs(X - M[imin,Ind]) < Rmin)
       then Indmin := imin;
     if (imax <= N1) and (imax > i)
      then if(Abs(X - M[imax,Ind]) < Rmin)
       then Indmin := imax;
     Row := ResultI(M, N2, Indmin);
     break;
   end;
 until false;
end;

procedure FindNearRSort(const M: TArrayR2; X: real; Ind:integer;
                   out Row: TArrayR1);
// Поиск ближайшего соответствия заданного значания X
// и элемента с индексом Ind
// строки сортированного массива действительных чисел M
// Row - найденная строка, первый ее элемент - индекс строки
var imin, imax, i, N1, N2:integer;
    Indmin: integer;
    Rmin: real;
begin
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре FindNearRSort :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
 N2 := High(M[0]);
 SetLength(Row, N2+2);
 imin :=-1;
 imax := N1+1;
 repeat
  i := (imin + imax) div 2;
  if(M[i,Ind] = X)
    then begin
     Row := ResultR(M, N2, i);
     break;
    end;
  if(M[i,Ind] > X)
   then imax := i
   else imin := i;
  if(imax - imin = 1)
   then begin
     Indmin := i;
     Rmin := Abs(X - M[i,Ind]);
     if (imin >= 0) and (imin < i)
      then if(Abs(X - M[imin,Ind]) < Rmin)
       then Indmin := imin;
     if (imax <= N1) and (imax > i)
      then if(Abs(X - M[imax,Ind]) < Rmin)
       then Indmin := imax;
     Row := ResultR(M, N2, Indmin);
     break;
   end;
 until false;
end;

procedure InterpRSort(const M: TArrayR2; X: real; Ind: integer;
                   out Row: TArrayR1);
// Поиск заданного значания X в элементах с индексом Ind
// строки сортированного массива действительных чисел M
// с линейной интерполяцией
// Row - результирующая строка
// Если X > максимального или < минимального элемента,
// то возвращается ближайшая строка
var imin, imax, i, j, N1, N2:integer;
    k: real;
begin
 N1 := High(M);
 if(N1 < 0)
   then begin
     Messages('Ошибка в процедуре InterpRSort :' +
              #13'не задан массив действительных чисел');
     exit;
   end;
 N2 := High(M[0]);
 SetLength(Row, N2+1);
 imin :=-1;
 imax := N1+1;
 repeat
  i := (imin + imax) div 2;
  if(M[i,Ind] = X)
    then begin
     for j:=0 to N2 do
      Row[j] := M[i,j];
     exit;
    end;
  if(M[i,Ind] > X)
   then imax := i
   else imin := i;
  if(imax - imin = 1)
   then begin
     if (imin >= 0) and (imax <= N1)
      then begin
        k:= (X - M[imin,Ind]) / (M[imax,Ind] - M[imin,Ind]);
        for j:=0 to N2 do
         Row[j] := M[imin,j] + (M[imax,j] - M[imin,j]) * k;
      end
      else
       for j:=0 to N2 do Row[j] := M[i,j];
     break;
   end;
 until false;
end;

end.
