////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2023 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// This unit containts Sort and search functions.                             //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20010729 - Creation (uses CRW16) & test                                    //
// 20020201 - modify QuickFind,QuickSearch (switch off KeyToSearch<>nil)      //
// 20230505 - Converted to FPC(A.K.)                                          //
////////////////////////////////////////////////////////////////////////////////

unit _crw_sort; // Sort and search routines.

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 sysutils, classes,
 _crw_alloc;

 {
 Purpose:
  "Compare" function uses by "sort" procedure to compare two given keys.
  Compare(Data,Key1,Key2) must return:
   1 if Key1^ > Key2^
   0 if Key1^ = Key2^
  -1 if Key1^ < Key2^
  Data is any user data
 }
type
 TCompareFunction = function(Data,Key1,Key2:Pointer):Integer;

 {
 Purpose:
  "KeyOf" function uses by "sort" procedure to get keys for sorting.
  KeyOf(Data,j) must return a pointer to key of Data[j], j=0..Count-1
  with given index j in a Data array.
 }
type
 TKeyOfFunction = function(Data:Pointer; i:Integer):Pointer;

 {
 Purpose:
  "Swap" procedure uses by "sort" procedure to sort data "in place".
  Swap(Data,i,j) must swap two elements of Data array.
 }
type
 TSwapProcedure = procedure(Data:Pointer; i,j:Integer);

 {
 Purpose:
   Enumerate sorting algorithms uses by "Sort" function.
 }
type
 TSortMethod = (smShellSort, smQuickSort);

 {
 Purpose:
   "Sort" is general function for fast sorting of any data array.
    User must specify "Compare" function to compare elements of data array,
    and "KeyOf" function to get a keys to compare.
    Moreover, user must specify one of this:
     "SwapData"  procedure to sort data "in place".
     "Index"     array to make "indexed" sorting.
  What is sorting "in place" and "indexed"?
  As result of sorting "in place", will return Data array, such that:
    Compare(Data,KeyOf(Data,i),KeyOf(Data,j))<=0, if i<=j
   This mean, Data[i] is sorted array:
    Data[i]<=Data[j], if i<=j
   Note, that original array will be changed by using "SwapData" procedure.
  As result of "indexed" sorting, will return "Index" array.
   This array will contains values, such that:
    Compare(Data,KeyOf(Data,Index[i]),KeyOf(Data,Index[j]))<=0, if i<=j
   This mean, Data[Index[i]] is sorted array:
    Data[Index[i]]<=Data[Index[j]], if i<=j
   Note, that original array will NOT be changed, but Index only.
   Why need both "in place" and "indexed" sorting methods?
   When uses sorting "in place", result is just sorted Data array.
   That is easy to use.
   But!
   In some programs Data array may be very large and data swap may be very
   slow. Moreover, Data array may be read-only (not accessable for changes).
   In that case, "indexed" sorting is a best way.
   "Sort" procedure uses different algoritms (smShellSort,smQuickSort),
   depends of "Method" argument.
   smQuickSort is well known recursive quick sort procedure. This recursive
     procedure may have a stack overflow problem when sort a large arrays.
   smShellSort is almost as fast as QuickSort, but without recursion.
     This is the "work horse" of fast sorting methods.

 Arguments:
  Count    : number of elements in Data array.
  Data     : points to data array[0..Count-1] to be sort.
  Compare  : Compare(Data,Key1,Key2)=-1/0/+1=LT/EQ/GT compares two keys.
  KeyOf    : KeyOf(Data,j), j=0..N-1 return key of element j in Data array.
  SwapData : procedure to exchange two elements of data to sort "in place".
  Index    : points to index array: Data[Index[i]] will be sorted, as result.
  Method   : uses sorting algorithm:
             smShellSort - default,"work horse" of fast sorting.
             smQuickSort - recursive version,may have a stack overflow.
 Result:
  Return true, if success sort.
  If assigned "SwapData", Data[i] array will be sorted.
  If assigned "Index", Data[Index[i]] array will be sorted.
  Return false, if sort fails. This mean, invalid input data:
   1) "Data","Compare","KeyOf" is not assigned.
   2) Both "SwapData" and "Index" assigned or not assigned.
      Only ONE OF "SwapData" and "Index" may be assigned.
  Notes:
  1. Only one of "SwapData" and "Index" may be assigned.
     To make sorting "in place", "SwapData" assigned, "Index" =nil.
     To make "indexed" sorting,  "SwapData"=nil,      "Index" assigned.
  2. "Data","Compare","KeyOff" pointers must be assigned.
  3. After sort procedure, use QuickSearch,QuickFind for fast data search.
  4. Be care, "Sort" uses untyped operations, type checking is turned off.
     Error in "Compare", "KeyOf", "Swap" may hang your program.
 }
function Sort(Count    : Integer;
              Data     : Pointer;
              Compare  : TCompareFunction;
              KeyOf    : TKeyOfFunction;
              SwapData : TSwapProcedure;
              Index    : PIntegerArray;
              Method   : TSortMethod = smShellSort
             ):boolean;

 {
 Purpose:
  QuickSearch,QuickFind are fast search procedures, that uses for both
   'just-sorted' and 'index-sorted' case.
   If Data array just sorted, call with Index=nil.
  QuickFind uses result of quick sort for fast data search. This procedure
   could not use to answer, are KeyToSearch contains in Data array or not.
   QuickFind only find index of interval, where KeyToSearch located.
  QuickSearch uses result of quick sort for fast data search. This procedure
   may be use to answer, are KeyToSearch contains in Data array or not.
   QuickSearch also search index of KeyToSearch to insert this key to
   sorted array of keys.
 Argiments:
  Count       : number of elements in Data array.
  Data        : points to data array to search in.
  Compare     : Compare(Data,Key1,Key2)=-1/0/+1=LT/EQ/GT compares two keys.
  KeyOf       : KeyOf(Data,j), j=0..N-1 return key of element j in Data array.
  KeyToSearch : points to key that you need to search.
  KeyIndex    : return index of key to be insert to.
  Index       : index array returned by sort procedures, such that array
                Data[Index[i]] is sorted. Index may be nil, if Data array
                just sorted "in place".
 Result:
  QuickFind search and return index i in sorted array Data[0..Count-1]
   wich satisfied next conditions:
                i=0        if Key<Data[0],
                i=Count-2  if Key>=Data[Count-1]
                Data[i] <= Key < Data[i+1] otherwise
   QuickFind usefull for interpolation procedures as linear interpolation,
   spline interpolation, etc.
 QuickSearch search given key and his index i in sorted array Data[0..Count-1]
  wich satisfyed next conditions:
               i=0        if Key<=Data[0],
               i=Count    if Key>Data[Count-1]
               x[i-1] < Key <= x[i] otherwise
  Index i just the same as place where Key may be insert in sorted collection.
  QuickSearch return true if Key found in Data array.
  This procedure usefull for collections, lists, etc.
 }
function QuickFind(Count       : Integer;
                   Data        : Pointer;
                   Compare     : TCompareFunction;
                   KeyOf       : TKeyOfFunction;
                   KeyToSearch : Pointer;
                   Index       : PIntegerArray = nil
                   ):Integer;
function  QuickSearch(Count       : Integer;
                      Data        : Pointer;
                      Compare     : TCompareFunction;
                      KeyOf       : TKeyOfFunction;
                      KeyToSearch : Pointer;
                  var KeyIndex    : Integer;
                      Index       : PIntegerArray = nil;
                      Duplicates  : boolean = false
                      ):boolean;

 {
  Purpose:
  Standard compare and keyof functions for fundamental arrays:
  Compare???s(Key1,Key2)   - compares two elements of type ???
  KeyOf???s(Data,KeyIndex) - gives the address of Data[KeyIndex] in array
                             Data[0..N-1] of type ???
  Swap???s(Data,i,j)       - exchanges two elements i,j in array
                             Data[0..N-1] of type ???
 }
function  CompareBytes(Data,Key1,Key2:Pointer):Integer;
function  KeyOfBytes(Data:Pointer; KeyIndex:Integer):Pointer;
procedure SwapBytes(Data:Pointer; i,j:Integer);
function  CompareShortInts(Data,Key1,Key2:Pointer):Integer;
function  KeyOfShortInts(Data:Pointer; KeyIndex:Integer):Pointer;
procedure SwapShortInts(Data:Pointer; i,j:Integer);
function  CompareWords(Data,Key1,Key2:Pointer):Integer;
function  KeyOfWords(Data:Pointer; KeyIndex:Integer):Pointer;
procedure SwapWords(Data:Pointer; i,j:Integer);
function  CompareSmallInts(Data,Key1,Key2:Pointer):Integer;
function  KeyOfSmallInts(Data:Pointer; KeyIndex:Integer):Pointer;
procedure SwapSmallInts(Data:Pointer; i,j:Integer);
function  CompareLongWords(Data,Key1,Key2:Pointer):Integer;
function  KeyOfLongWords(Data:Pointer; KeyIndex:Integer):Pointer;
procedure SwapLongWords(Data:Pointer; i,j:Integer);
function  CompareLongInts(Data,Key1,Key2:Pointer):Integer;
function  KeyOfLongInts(Data:Pointer; KeyIndex:Integer):Pointer;
procedure SwapLongInts(Data:Pointer; i,j:Integer);
function  CompareCardinals(Data,Key1,Key2:Pointer):Integer;
function  KeyOfCardinals(Data:Pointer; KeyIndex:Integer):Pointer;
procedure SwapCardinals(Data:Pointer; i,j:Integer);
function  CompareInt64s(Data,Key1,Key2:Pointer):Integer;
function  KeyOfInt64s(Data:Pointer; KeyIndex:Integer):Pointer;
procedure SwapInt64s(Data:Pointer; i,j:Integer);
function  CompareSingles(Data,Key1,Key2:Pointer):Integer;
function  KeyOfSingles(Data:Pointer; KeyIndex:Integer):Pointer;
procedure SwapSingles(Data:Pointer; i,j:Integer);
function  CompareDoubles(Data,Key1,Key2:Pointer):Integer;
function  KeyOfDoubles(Data:Pointer; KeyIndex:Integer):Pointer;
procedure SwapDoubles(Data:Pointer; i,j:Integer);
function  CompareComps(Data,Key1,Key2:Pointer):Integer;
function  KeyOfComps(Data:Pointer; KeyIndex:Integer):Pointer;
procedure SwapComps(Data:Pointer; i,j:Integer);
function  CompareExtendeds(Data,Key1,Key2:Pointer):Integer;
function  KeyOfExtendeds(Data:Pointer; KeyIndex:Integer):Pointer;
procedure SwapExtendeds(Data:Pointer; i,j:Integer);

 {
 Purpose:
  SortIndex is fast sorting procedure for standard arrays.
  SortIndex is "indexed" sort procedure, Key array does not change,
  but Index only change.
 Result:
  SortIndex(N,Key,Index,Method) returns Index array, such that
  Key[Index[i]], i=0..N-1 is sorted. Method means 0=shell sort, 1=quick sort.
 }
function SortIndex(N:integer; const Key :array of Byte;     Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray; overload;
function SortIndex(N:integer; const Key :array of ShortInt; Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray; overload;
function SortIndex(N:integer; const Key :array of Word;     Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray; overload;
function SortIndex(N:integer; const Key :array of SmallInt; Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray; overload;
function SortIndex(N:integer; const Key :array of LongWord; Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray; overload;
function SortIndex(N:integer; const Key :array of LongInt;  Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray; overload;
function SortIndex(N:integer; const Key :array of Int64;    Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray; overload;
function SortIndex(N:integer; const Key :array of Single;   Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray; overload;
function SortIndex(N:integer; const Key :array of Double;   Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray; overload;
function SortIndex(N:integer; const Key :array of Comp;     Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray; overload;
function SortIndex(N:integer; const Key :array of Extended; Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray; overload;
procedure QuickSortDoubleXY(N:integer; var x,y:array of double);

 {
 Purpose:
   i=FindIndex(N,x,at,index=nil) search index i in sorted array x[0..N-1].
   Array x MUST be sorted as x[i]<=x[i+1] or x[index[i]]<=x[index[i+1]].
   Usefull for interpolation procedures.
  Return:
   i:=FindIndex(N,x,at) returns index i, for which x[i]<=at<x[i+1]
   i=0, if at < x[0]
   i=N-2, if at > x[N-2]
   If index present (index<>nil), then x[i] replaces to x[index[i]].
 }
function FindIndex(N:Integer; const x:array of Byte;     at:Byte;     index:PIntegerArray=nil):Integer; overload;
function FindIndex(N:Integer; const x:array of ShortInt; at:ShortInt; index:PIntegerArray=nil):Integer; overload;
function FindIndex(N:Integer; const x:array of Word;     at:Word;     index:PIntegerArray=nil):Integer; overload;
function FindIndex(N:Integer; const x:array of SmallInt; at:SmallInt; index:PIntegerArray=nil):Integer; overload;
function FindIndex(N:Integer; const x:array of LongWord; at:LongWord; index:PIntegerArray=nil):Integer; overload;
function FindIndex(N:Integer; const x:array of LongInt;  at:LongInt;  index:PIntegerArray=nil):Integer; overload;
function FindIndex(N:Integer; const x:array of Int64;    at:Int64;    index:PIntegerArray=nil):Integer; overload;
function FindIndex(N:Integer; const x:array of Single;   at:Single;   index:PIntegerArray=nil):Integer; overload;
function FindIndex(N:Integer; const x:array of Double;   at:Double;   index:PIntegerArray=nil):Integer; overload;
function FindIndex(N:Integer; const x:array of Comp;     at:Comp;     index:PIntegerArray=nil):Integer; overload;
function FindIndex(N:Integer; const x:array of Extended; at:Extended; index:PIntegerArray=nil):Integer; overload;

 {
 Purpose:
  Check, is  array x[0..N-1] sorted or not with Eps precision.
  Uses x[Index[i]] array if Index is not nil.
 }
function isSortedArray(N:Integer; const x:array of Byte;     Index:PIntegerArray; Eps:Byte=0;     Revers:boolean=false):boolean; overload;
function isSortedArray(N:Integer; const x:array of ShortInt; Index:PIntegerArray; Eps:ShortInt=0; Revers:boolean=false):boolean; overload;
function isSortedArray(N:Integer; const x:array of Word;     Index:PIntegerArray; Eps:Word=0;     Revers:boolean=false):boolean; overload;
function isSortedArray(N:Integer; const x:array of SmallInt; Index:PIntegerArray; Eps:SmallInt=0; Revers:boolean=false):boolean; overload;
function isSortedArray(N:Integer; const x:array of LongWord; Index:PIntegerArray; Eps:LongWord=0; Revers:boolean=false):boolean; overload;
function isSortedArray(N:Integer; const x:array of LongInt;  Index:PIntegerArray; Eps:LongInt=0;  Revers:boolean=false):boolean; overload;
function isSortedArray(N:Integer; const x:array of Int64;    Index:PIntegerArray; Eps:Int64=0;    Revers:boolean=false):boolean; overload;
function isSortedArray(N:Integer; const x:array of Single;   Index:PIntegerArray; Eps:Single=0;   Revers:boolean=false):boolean; overload;
function isSortedArray(N:Integer; const x:array of Double;   Index:PIntegerArray; Eps:Double=0;   Revers:boolean=false):boolean; overload;
function isSortedArray(N:Integer; const x:array of Comp;     Index:PIntegerArray; Eps:Comp=0;     Revers:boolean=false):boolean; overload;
function isSortedArray(N:Integer; const x:array of Extended; Index:PIntegerArray; Eps:Extended=0; Revers:boolean=false):boolean; overload;

implementation

 {
 General quick sort & search procedures
 }

function Sort(Count    : Integer;
              Data     : Pointer;
              Compare  : TCompareFunction;
              KeyOf    : TKeyOfFunction;
              SwapData : TSwapProcedure;
              Index    : PIntegerArray;
              Method   : TSortMethod = smShellSort
             ):boolean;
var i:Integer;
 {
 The shell sort procedure, "in place" version.
 }
 procedure Shell_Sort_InPlace;
 var gap,i,j:Integer;
 begin
  gap:=Count shr 1;
  while gap>0 do begin
   i:=gap;
   while i<Count do begin
    j:=i-gap;
    while (j>=0) and (Compare(Data,KeyOf(Data,j+gap),KeyOf(Data,j))<0) do begin
     SwapData(Data,j+gap,j);
     dec(j,gap);
    end;
    inc(i);
   end;
   gap:=gap shr 1;
  end;
 end;
 {
 The shell sort procedure, "indexed" version.
 }
 procedure Shell_Sort_Indexed;
 var gap,i,j,k:Integer;
 begin
  gap:=Count shr 1;
  while gap>0 do begin
   i:=gap;
   while i<Count do begin
    j:=i-gap;
    while (j>=0) and (Compare(Data,KeyOf(Data,Index[j+gap]),KeyOf(Data,Index[j]))<0)
    do begin
     k:=Index[j+gap]; Index[j+gap]:=Index[j]; Index[j]:=k;
     dec(j,gap);
    end;
    inc(i);
   end;
   gap:=gap shr 1;
  end;
 end;
 {
 The recursive quick sort procedure, "indexed" version.
 }
 procedure Quick_Sort_Indexed(L,R:Integer);
 var i,j,k,m:Integer;
 begin
  i:=L;
  j:=R;
  m:=Index[(L+R) shr 1];
  while (i<=j) do begin
   while Compare(Data,KeyOf(Data,Index[i]),KeyOf(Data,m))<0 do Inc(i);
   while Compare(Data,KeyOf(Data,m),KeyOf(Data,Index[j]))<0 do Dec(j);
   if i<=j then begin
    k:=Index[i]; Index[i]:=Index[j]; Index[j]:=k;
    Inc(i);
    Dec(j);
   end;
  end;
  if L<j then Quick_Sort_Indexed(L,j);
  if i<R then Quick_Sort_Indexed(i,R);
 end;
 {
 The recursive quick sort procedure, "in place" version.
 }
 procedure Quick_Sort_InPlace_1(L,R:integer);
 var i,j,m:integer;
 begin
  i:=L;
  j:=R;
  m:=(L+R) shr 1;
  while (i<=j) do begin
   while Compare(Data,KeyOf(Data,i),KeyOf(Data,m))<0 do inc(i);
   while Compare(Data,KeyOf(Data,m),KeyOf(Data,j))<0 do dec(j);
   if i <= j then begin
    SwapData(Data,i,j);
    if m=i then m:=j else if m=j then m:=i; { pivot element swapped! }
    inc(i);
    dec(j);
   end;
  end;
  if L<j then Quick_Sort_InPlace_1(L,j);
  if i<R then Quick_Sort_InPlace_1(i,R);
 end;
 { yet another one }
 procedure Quick_Sort_InPlace_2(Left,Right:Integer);
 var i,Last:Integer;
 begin
  if Left<Right then begin
   SwapData(Data,Left,(Left+Right) shr 1);
   Last:=Left;
   for i:=Left+1 to Right do
   if Compare(Data,KeyOf(Data,i),KeyOf(Data,Left))<0 then begin
    inc(Last);
    SwapData(Data,Last,i);
   end;
   SwapData(Data,Left,Last);
   Quick_Sort_InPlace_2(Left,Last-1);
   Quick_Sort_InPlace_2(Last+1,Right);
  end;
 end;
begin
 Result:=false;
 if Assigned(Data) and Assigned(Compare) and Assigned(KeyOf) then begin
  if Assigned(Index) then begin
   if not Assigned(SwapData) then begin
    Result:=true;
    for i:=0 to Count-1 do Index[i]:=i;
    if Count>1 then
    case Method of
     smShellSort: Shell_Sort_Indexed;
     smQuickSort: Quick_Sort_Indexed(0,Count-1);
     else Result:=false;
    end;
   end;
  end else begin
   if Assigned(SwapData) then begin
    Result:=true;
    if Count>1 then
    case Method of
     smShellSort: Shell_Sort_InPlace;
     smQuickSort: Quick_Sort_InPlace_1(0,Count-1);
     else Result:=false;
    end;
   end;
  end;
 end;
end;

function QuickFind(Count       : Integer;
                   Data        : Pointer;
                   Compare     : TCompareFunction;
                   KeyOf       : TKeyOfFunction;
                   KeyToSearch : Pointer;
                   Index       : PIntegerArray = nil
                   ):Integer;
var Left,Right,Middle,Comparison:Integer;
begin
 Left:=0;
 Right:=Count-1;
 if Assigned(Data) and Assigned(Compare) and Assigned(KeyOf) then
 while Right > Left+1 do begin
  Middle:=(Left+Right) shr 1;
  if Assigned(Index)
  then Comparison:=Compare(Data,KeyToSearch,KeyOf(Data,Index[Middle]))
  else Comparison:=Compare(Data,KeyToSearch,KeyOf(Data,Middle));
  if Comparison<0 then Right:=Middle else Left:=Middle;
 end;
 Result:=Left;
end;

function QuickSearch(Count       : Integer;
                     Data        : Pointer;
                     Compare     : TCompareFunction;
                     KeyOf       : TKeyOfFunction;
                     KeyToSearch : Pointer;
                 var KeyIndex    : Integer;
                     Index       : PIntegerArray = nil;
                     Duplicates  : boolean = false
                     ):boolean;
var Left,Right,Middle,Comparison:Integer;
begin
 Result := False;
 Left:=0;
 Right:=Count-1;
 if Assigned(Data) and Assigned(Compare) and Assigned(KeyOf) then
 while Left<=Right do begin
  Middle:=(Left+Right) shr 1;
  if Assigned(Index)
  then Comparison:=Compare(Data,KeyOf(Data,Index[Middle]),KeyToSearch)
  else Comparison:=Compare(Data,KeyOf(Data,Middle),KeyToSearch);
  if Comparison<0 then Left:=Middle+1 else begin
   Right:=Middle-1;
   if Comparison=0 then begin
    Result:=True;
    if not Duplicates then Left:=Middle;
   end;
  end;
 end;
 KeyIndex:=Left;
end;

 {
 Compare, KeyOff & Swap functions for standard types
 }

function CompareBytes(Data,Key1,Key2:Pointer):Integer;
begin
 if Byte(Key1^)<Byte(Key2^) then Result:=-1 else
 if Byte(Key1^)>Byte(Key2^) then Result:=+1 else Result:= 0;
end;

function KeyOfBytes(Data:Pointer; KeyIndex:Integer):Pointer;
begin
 Result:=@TByteArray(Data^)[KeyIndex];
end;

procedure SwapBytes(Data:Pointer; i,j:Integer);
var dummy:Byte;
begin
 dummy:=TByteArray(Data^)[i];
 TByteArray(Data^)[i]:=TByteArray(Data^)[j];
 TByteArray(Data^)[j]:=dummy;
end;

function CompareShortInts(Data,Key1,Key2:Pointer):Integer;
begin
 if ShortInt(Key1^)<ShortInt(Key2^) then Result:=-1 else
 if ShortInt(Key1^)>ShortInt(Key2^) then Result:=+1 else Result:= 0;
end;

function KeyOfShortInts(Data:Pointer; KeyIndex:Integer):Pointer;
begin
 Result:=@TShortIntArray(Data^)[KeyIndex];
end;

procedure SwapShortInts(Data:Pointer; i,j:Integer);
var dummy:ShortInt;
begin
 dummy:=TShortIntArray(Data^)[i];
 TShortIntArray(Data^)[i]:=TShortIntArray(Data^)[j];
 TShortIntArray(Data^)[j]:=dummy;
end;

function CompareWords(Data,Key1,Key2:Pointer):Integer;
begin
 if Word(Key1^)<Word(Key2^) then Result:=-1 else
 if Word(Key1^)>Word(Key2^) then Result:=+1 else Result:= 0;
end;

function KeyOfWords(Data:Pointer; KeyIndex:Integer):Pointer;
begin
 Result:=@TWordArray(Data^)[KeyIndex];
end;

procedure SwapWords(Data:Pointer; i,j:Integer);
var dummy:Word;
begin
 dummy:=TWordArray(Data^)[i];
 TWordArray(Data^)[i]:=TWordArray(Data^)[j];
 TWordArray(Data^)[j]:=dummy;
end;

function CompareSmallInts(Data,Key1,Key2:Pointer):Integer;
begin
 if SmallInt(Key1^)<SmallInt(Key2^) then Result:=-1 else
 if SmallInt(Key1^)>SmallInt(Key2^) then Result:=+1 else Result:= 0;
end;

function KeyOfSmallInts(Data:Pointer; KeyIndex:Integer):Pointer;
begin
 Result:=@TSmallIntArray(Data^)[KeyIndex];
end;

procedure SwapSmallInts(Data:Pointer; i,j:Integer);
var dummy:SmallInt;
begin
 dummy:=TSmallIntArray(Data^)[i];
 TSmallIntArray(Data^)[i]:=TSmallIntArray(Data^)[j];
 TSmallIntArray(Data^)[j]:=dummy;
end;

function CompareLongWords(Data,Key1,Key2:Pointer):Integer;
begin
 if LongWord(Key1^)<LongWord(Key2^) then Result:=-1 else
 if LongWord(Key1^)>LongWord(Key2^) then Result:=+1 else Result:= 0;
end;

function KeyOfLongWords(Data:Pointer; KeyIndex:Integer):Pointer;
begin
 Result:=@TLongWordArray(Data^)[KeyIndex];
end;

procedure SwapLongWords(Data:Pointer; i,j:Integer);
var dummy:LongWord;
begin
 dummy:=TLongWordArray(Data^)[i];
 TLongWordArray(Data^)[i]:=TLongWordArray(Data^)[j];
 TLongWordArray(Data^)[j]:=dummy;
end;

function CompareLongInts(Data,Key1,Key2:Pointer):Integer;
begin
 if LongInt(Key1^)<LongInt(Key2^) then Result:=-1 else
 if LongInt(Key1^)>LongInt(Key2^) then Result:=+1 else Result:= 0;
end;

function KeyOfLongInts(Data:Pointer; KeyIndex:Integer):Pointer;
begin
 Result:=@TLongIntArray(Data^)[KeyIndex];
end;

procedure SwapLongInts(Data:Pointer; i,j:Integer);
var dummy:LongInt;
begin
 dummy:=TLongIntArray(Data^)[i];
 TLongIntArray(Data^)[i]:=TLongIntArray(Data^)[j];
 TLongIntArray(Data^)[j]:=dummy;
end;

function CompareCardinals(Data,Key1,Key2:Pointer):Integer;
begin
 if Cardinal(Key1^)<Cardinal(Key2^) then Result:=-1 else
 if Cardinal(Key1^)>Cardinal(Key2^) then Result:=+1 else Result:= 0;
end;

function KeyOfCardinals(Data:Pointer; KeyIndex:Integer):Pointer;
begin
 Result:=@TCardinalArray(Data^)[KeyIndex];
end;

procedure SwapCardinals(Data:Pointer; i,j:Integer);
var dummy:Cardinal;
begin
 dummy:=TCardinalArray(Data^)[i];
 TCardinalArray(Data^)[i]:=TCardinalArray(Data^)[j];
 TCardinalArray(Data^)[j]:=dummy;
end;

function CompareInt64s(Data,Key1,Key2:Pointer):Integer;
begin
 if Int64(Key1^)<Int64(Key2^) then Result:=-1 else
 if Int64(Key1^)>Int64(Key2^) then Result:=+1 else Result:= 0;
end;

function KeyOfInt64s(Data:Pointer; KeyIndex:Integer):Pointer;
begin
 Result:=@TInt64Array(Data^)[KeyIndex];
end;

procedure SwapInt64s(Data:Pointer; i,j:Integer);
var dummy:Int64;
begin
 dummy:=TInt64Array(Data^)[i];
 TInt64Array(Data^)[i]:=TInt64Array(Data^)[j];
 TInt64Array(Data^)[j]:=dummy;
end;

function CompareSingles(Data,Key1,Key2:Pointer):Integer;
begin
 if Single(Key1^)<Single(Key2^) then Result:=-1 else
 if Single(Key1^)>Single(Key2^) then Result:=+1 else Result:= 0;
end;

function KeyOfSingles(Data:Pointer; KeyIndex:Integer):Pointer;
begin
 Result:=@TSingleArray(Data^)[KeyIndex];
end;

procedure SwapSingles(Data:Pointer; i,j:Integer);
var dummy:Single;
begin
 dummy:=TSingleArray(Data^)[i];
 TSingleArray(Data^)[i]:=TSingleArray(Data^)[j];
 TSingleArray(Data^)[j]:=dummy;
end;

function CompareDoubles(Data,Key1,Key2:Pointer):Integer;
begin
 if Double(Key1^)<Double(Key2^) then Result:=-1 else
 if Double(Key1^)>Double(Key2^) then Result:=+1 else Result:= 0;
end;

function KeyOfDoubles(Data:Pointer; KeyIndex:Integer):Pointer;
begin
 Result:=@TDoubleArray(Data^)[KeyIndex];
end;

procedure SwapDoubles(Data:Pointer; i,j:Integer);
var dummy:Double;
begin
 dummy:=TDoubleArray(Data^)[i];
 TDoubleArray(Data^)[i]:=TDoubleArray(Data^)[j];
 TDoubleArray(Data^)[j]:=dummy;
end;

function CompareComps(Data,Key1,Key2:Pointer):Integer;
begin
 if Comp(Key1^)<Comp(Key2^) then Result:=-1 else
 if Comp(Key1^)>Comp(Key2^) then Result:=+1 else Result:= 0;
end;

function KeyOfComps(Data:Pointer; KeyIndex:Integer):Pointer;
begin
 Result:=@TCompArray(Data^)[KeyIndex];
end;

procedure SwapComps(Data:Pointer; i,j:Integer);
var dummy:Comp;
begin
 dummy:=TCompArray(Data^)[i];
 TCompArray(Data^)[i]:=TCompArray(Data^)[j];
 TCompArray(Data^)[j]:=dummy;
end;

function CompareExtendeds(Data,Key1,Key2:Pointer):Integer;
begin
 if Extended(Key1^)<Extended(Key2^) then Result:=-1 else
 if Extended(Key1^)>Extended(Key2^) then Result:=+1 else Result:= 0;
end;

function KeyOfExtendeds(Data:Pointer; KeyIndex:Integer):Pointer;
begin
 Result:=@TExtendedArray(Data^)[KeyIndex];
end;

procedure SwapExtendeds(Data:Pointer; i,j:Integer);
var dummy:Extended;
begin
 dummy:=TExtendedArray(Data^)[i];
 TExtendedArray(Data^)[i]:=TExtendedArray(Data^)[j];
 TExtendedArray(Data^)[j]:=dummy;
end;

 {
 Fast sort for standard arrays
 }

function SortIndex(N:integer; const Key :array of byte; Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray;
var i:integer;
 procedure Quick_Sort(l,r:integer);
 var i,j,k,m:integer;
 begin
  i:=l; j:=r; m:=Index[(l+r) shr 1];
  while (i<=j) do begin
   while Key[Index[i]]<Key[m] do inc(i);
   while Key[m]<Key[Index[j]] do dec(j);
   if i <= j then begin
    k:=Index[i]; Index[i]:=Index[j]; Index[j]:=k;
    inc(i);
    dec(j);
   end;
  end;
  if l<j then Quick_Sort(l,j);
  if i<r then Quick_Sort(i,r);
 end;
 procedure Shell_Sort;
 var gap,i,j,k:Integer;
 begin
  gap:=N shr 1;
  while gap>0 do begin
   i:=gap;
   while i<N do begin
    j:=i-gap;
    while (j>=0) and (Key[Index[j+gap]]<Key[Index[j]]) do begin
     k:=Index[j]; Index[j]:=Index[j+gap]; Index[j+gap]:=k;
     dec(j,gap);
    end;
    inc(i);
   end;
   gap:=gap shr 1;
  end;
 end;
begin
 Result:=Index;
 if Assigned(Index) then begin
  for i:=0 to N-1 do Index[i]:=i;
  if N>1 then
  case Method of
   smShellSort: Shell_Sort;
   smQuickSort: Quick_Sort(0,N-1);
   else Shell_Sort;
  end;
 end;
end;
function SortIndex(N:integer; const Key :array of ShortInt; Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray;
var i:integer;
 procedure Quick_Sort(l,r:integer);
 var i,j,k,m:integer;
 begin
  i:=l; j:=r; m:=Index[(l+r) shr 1];
  while (i<=j) do begin
   while Key[Index[i]]<Key[m] do inc(i);
   while Key[m]<Key[Index[j]] do dec(j);
   if i <= j then begin
    k:=Index[i]; Index[i]:=Index[j]; Index[j]:=k;
    inc(i);
    dec(j);
   end;
  end;
  if l<j then Quick_Sort(l,j);
  if i<r then Quick_Sort(i,r);
 end;
 procedure Shell_Sort;
 var gap,i,j,k:Integer;
 begin
  gap:=N shr 1;
  while gap>0 do begin
   i:=gap;
   while i<N do begin
    j:=i-gap;
    while (j>=0) and (Key[Index[j+gap]]<Key[Index[j]]) do begin
     k:=Index[j]; Index[j]:=Index[j+gap]; Index[j+gap]:=k;
     dec(j,gap);
    end;
    inc(i);
   end;
   gap:=gap shr 1;
  end;
 end;
begin
 Result:=Index;
 if Assigned(Index) then begin
  for i:=0 to N-1 do Index[i]:=i;
  if N>1 then
  case Method of
   smShellSort: Shell_Sort;
   smQuickSort: Quick_Sort(0,N-1);
   else Shell_Sort;
  end;
 end;
end;
function SortIndex(N:integer; const Key :array of Word; Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray;
var i:integer;
 procedure Quick_Sort(l,r:integer);
 var i,j,k,m:integer;
 begin
  i:=l; j:=r; m:=Index[(l+r) shr 1];
  while (i<=j) do begin
   while Key[Index[i]]<Key[m] do inc(i);
   while Key[m]<Key[Index[j]] do dec(j);
   if i <= j then begin
    k:=Index[i]; Index[i]:=Index[j]; Index[j]:=k;
    inc(i);
    dec(j);
   end;
  end;
  if l<j then Quick_Sort(l,j);
  if i<r then Quick_Sort(i,r);
 end;
 procedure Shell_Sort;
 var gap,i,j,k:Integer;
 begin
  gap:=N shr 1;
  while gap>0 do begin
   i:=gap;
   while i<N do begin
    j:=i-gap;
    while (j>=0) and (Key[Index[j+gap]]<Key[Index[j]]) do begin
     k:=Index[j]; Index[j]:=Index[j+gap]; Index[j+gap]:=k;
     dec(j,gap);
    end;
    inc(i);
   end;
   gap:=gap shr 1;
  end;
 end;
begin
 Result:=Index;
 if Assigned(Index) then begin
  for i:=0 to N-1 do Index[i]:=i;
  if N>1 then
  case Method of
   smShellSort: Shell_Sort;
   smQuickSort: Quick_Sort(0,N-1);
   else Shell_Sort;
  end;
 end;
end;
function SortIndex(N:integer; const Key :array of SmallInt; Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray;
var i:integer;
 procedure Quick_Sort(l,r:integer);
 var i,j,k,m:integer;
 begin
  i:=l; j:=r; m:=Index[(l+r) shr 1];
  while (i<=j) do begin
   while Key[Index[i]]<Key[m] do inc(i);
   while Key[m]<Key[Index[j]] do dec(j);
   if i <= j then begin
    k:=Index[i]; Index[i]:=Index[j]; Index[j]:=k;
    inc(i);
    dec(j);
   end;
  end;
  if l<j then Quick_Sort(l,j);
  if i<r then Quick_Sort(i,r);
 end;
 procedure Shell_Sort;
 var gap,i,j,k:Integer;
 begin
  gap:=N shr 1;
  while gap>0 do begin
   i:=gap;
   while i<N do begin
    j:=i-gap;
    while (j>=0) and (Key[Index[j+gap]]<Key[Index[j]]) do begin
     k:=Index[j]; Index[j]:=Index[j+gap]; Index[j+gap]:=k;
     dec(j,gap);
    end;
    inc(i);
   end;
   gap:=gap shr 1;
  end;
 end;
begin
 Result:=Index;
 if Assigned(Index) then begin
  for i:=0 to N-1 do Index[i]:=i;
  if N>1 then
  case Method of
   smShellSort: Shell_Sort;
   smQuickSort: Quick_Sort(0,N-1);
   else Shell_Sort;
  end;
 end;
end;
function SortIndex(N:integer; const Key :array of LongWord; Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray;
var i:integer;
 procedure Quick_Sort(l,r:integer);
 var i,j,k,m:integer;
 begin
  i:=l; j:=r; m:=Index[(l+r) shr 1];
  while (i<=j) do begin
   while Key[Index[i]]<Key[m] do inc(i);
   while Key[m]<Key[Index[j]] do dec(j);
   if i <= j then begin
    k:=Index[i]; Index[i]:=Index[j]; Index[j]:=k;
    inc(i);
    dec(j);
   end;
  end;
  if l<j then Quick_Sort(l,j);
  if i<r then Quick_Sort(i,r);
 end;
 procedure Shell_Sort;
 var gap,i,j,k:Integer;
 begin
  gap:=N shr 1;
  while gap>0 do begin
   i:=gap;
   while i<N do begin
    j:=i-gap;
    while (j>=0) and (Key[Index[j+gap]]<Key[Index[j]]) do begin
     k:=Index[j]; Index[j]:=Index[j+gap]; Index[j+gap]:=k;
     dec(j,gap);
    end;
    inc(i);
   end;
   gap:=gap shr 1;
  end;
 end;
begin
 Result:=Index;
 if Assigned(Index) then begin
  for i:=0 to N-1 do Index[i]:=i;
  if N>1 then
  case Method of
   smShellSort: Shell_Sort;
   smQuickSort: Quick_Sort(0,N-1);
   else Shell_Sort;
  end;
 end;
end;
function SortIndex(N:integer; const Key :array of LongInt;  Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray;
var i:integer;
 procedure Quick_Sort(l,r:integer);
 var i,j,k,m:integer;
 begin
  i:=l; j:=r; m:=Index[(l+r) shr 1];
  while (i<=j) do begin
   while Key[Index[i]]<Key[m] do inc(i);
   while Key[m]<Key[Index[j]] do dec(j);
   if i <= j then begin
    k:=Index[i]; Index[i]:=Index[j]; Index[j]:=k;
    inc(i);
    dec(j);
   end;
  end;
  if l<j then Quick_Sort(l,j);
  if i<r then Quick_Sort(i,r);
 end;
 procedure Shell_Sort;
 var gap,i,j,k:Integer;
 begin
  gap:=N shr 1;
  while gap>0 do begin
   i:=gap;
   while i<N do begin
    j:=i-gap;
    while (j>=0) and (Key[Index[j+gap]]<Key[Index[j]]) do begin
     k:=Index[j]; Index[j]:=Index[j+gap]; Index[j+gap]:=k;
     dec(j,gap);
    end;
    inc(i);
   end;
   gap:=gap shr 1;
  end;
 end;
begin
 Result:=Index;
 if Assigned(Index) then begin
  for i:=0 to N-1 do Index[i]:=i;
  if N>1 then
  case Method of
   smShellSort: Shell_Sort;
   smQuickSort: Quick_Sort(0,N-1);
   else Shell_Sort;
  end;
 end;
end;
function SortIndex(N:integer; const Key :array of Int64; Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray;
var i:integer;
 procedure Quick_Sort(l,r:integer);
 var i,j,k,m:integer;
 begin
  i:=l; j:=r; m:=Index[(l+r) shr 1];
  while (i<=j) do begin
   while Key[Index[i]]<Key[m] do inc(i);
   while Key[m]<Key[Index[j]] do dec(j);
   if i <= j then begin
    k:=Index[i]; Index[i]:=Index[j]; Index[j]:=k;
    inc(i);
    dec(j);
   end;
  end;
  if l<j then Quick_Sort(l,j);
  if i<r then Quick_Sort(i,r);
 end;
 procedure Shell_Sort;
 var gap,i,j,k:Integer;
 begin
  gap:=N shr 1;
  while gap>0 do begin
   i:=gap;
   while i<N do begin
    j:=i-gap;
    while (j>=0) and (Key[Index[j+gap]]<Key[Index[j]]) do begin
     k:=Index[j]; Index[j]:=Index[j+gap]; Index[j+gap]:=k;
     dec(j,gap);
    end;
    inc(i);
   end;
   gap:=gap shr 1;
  end;
 end;
begin
 Result:=Index;
 if Assigned(Index) then begin
  for i:=0 to N-1 do Index[i]:=i;
  if N>1 then
  case Method of
   smShellSort: Shell_Sort;
   smQuickSort: Quick_Sort(0,N-1);
   else Shell_Sort;
  end;
 end;
end;
function SortIndex(N:integer; const Key :array of Single; Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray;
var i:integer;
 procedure Quick_Sort(l,r:integer);
 var i,j,k,m:integer;
 begin
  i:=l; j:=r; m:=Index[(l+r) shr 1];
  while (i<=j) do begin
   while Key[Index[i]]<Key[m] do inc(i);
   while Key[m]<Key[Index[j]] do dec(j);
   if i <= j then begin
    k:=Index[i]; Index[i]:=Index[j]; Index[j]:=k;
    inc(i);
    dec(j);
   end;
  end;
  if l<j then Quick_Sort(l,j);
  if i<r then Quick_Sort(i,r);
 end;
 procedure Shell_Sort;
 var gap,i,j,k:Integer;
 begin
  gap:=N shr 1;
  while gap>0 do begin
   i:=gap;
   while i<N do begin
    j:=i-gap;
    while (j>=0) and (Key[Index[j+gap]]<Key[Index[j]]) do begin
     k:=Index[j]; Index[j]:=Index[j+gap]; Index[j+gap]:=k;
     dec(j,gap);
    end;
    inc(i);
   end;
   gap:=gap shr 1;
  end;
 end;
begin
 Result:=Index;
 if Assigned(Index) then begin
  for i:=0 to N-1 do Index[i]:=i;
  if N>1 then
  case Method of
   smShellSort: Shell_Sort;
   smQuickSort: Quick_Sort(0,N-1);
   else Shell_Sort;
  end;
 end;
end;
function SortIndex(N:integer; const Key :array of Double; Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray;
var i:integer;
 procedure Quick_Sort(l,r:integer);
 var i,j,k,m:integer;
 begin
  i:=l; j:=r; m:=Index[(l+r) shr 1];
  while (i<=j) do begin
   while Key[Index[i]]<Key[m] do inc(i);
   while Key[m]<Key[Index[j]] do dec(j);
   if i <= j then begin
    k:=Index[i]; Index[i]:=Index[j]; Index[j]:=k;
    inc(i);
    dec(j);
   end;
  end;
  if l<j then Quick_Sort(l,j);
  if i<r then Quick_Sort(i,r);
 end;
 procedure Shell_Sort;
 var gap,i,j,k:Integer;
 begin
  gap:=N shr 1;
  while gap>0 do begin
   i:=gap;
   while i<N do begin
    j:=i-gap;
    while (j>=0) and (Key[Index[j+gap]]<Key[Index[j]]) do begin
     k:=Index[j]; Index[j]:=Index[j+gap]; Index[j+gap]:=k;
     dec(j,gap);
    end;
    inc(i);
   end;
   gap:=gap shr 1;
  end;
 end;
begin
 Result:=Index;
 if Assigned(Index) then begin
  for i:=0 to N-1 do Index[i]:=i;
  if N>1 then
  case Method of
   smShellSort: Shell_Sort;
   smQuickSort: Quick_Sort(0,N-1);
   else Shell_Sort;
  end;
 end;
end;
function SortIndex(N:integer; const Key :array of Comp; Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray;
var i:integer;
 procedure Quick_Sort(l,r:integer);
 var i,j,k,m:integer;
 begin
  i:=l; j:=r; m:=Index[(l+r) shr 1];
  while (i<=j) do begin
   while Key[Index[i]]<Key[m] do inc(i);
   while Key[m]<Key[Index[j]] do dec(j);
   if i <= j then begin
    k:=Index[i]; Index[i]:=Index[j]; Index[j]:=k;
    inc(i);
    dec(j);
   end;
  end;
  if l<j then Quick_Sort(l,j);
  if i<r then Quick_Sort(i,r);
 end;
 procedure Shell_Sort;
 var gap,i,j,k:Integer;
 begin
  gap:=N shr 1;
  while gap>0 do begin
   i:=gap;
   while i<N do begin
    j:=i-gap;
    while (j>=0) and (Key[Index[j+gap]]<Key[Index[j]]) do begin
     k:=Index[j]; Index[j]:=Index[j+gap]; Index[j+gap]:=k;
     dec(j,gap);
    end;
    inc(i);
   end;
   gap:=gap shr 1;
  end;
 end;
begin
 Result:=Index;
 if Assigned(Index) then begin
  for i:=0 to N-1 do Index[i]:=i;
  if N>1 then
  case Method of
   smShellSort: Shell_Sort;
   smQuickSort: Quick_Sort(0,N-1);
   else Shell_Sort;
  end;
 end;
end;
function SortIndex(N:integer; const Key :array of Extended; Index:PIntegerArray; Method:TSortMethod=smShellSort):PIntegerArray;
var i:integer;
 procedure Quick_Sort(l,r:integer);
 var i,j,k,m:integer;
 begin
  i:=l; j:=r; m:=Index[(l+r) shr 1];
  while (i<=j) do begin
   while Key[Index[i]]<Key[m] do inc(i);
   while Key[m]<Key[Index[j]] do dec(j);
   if i <= j then begin
    k:=Index[i]; Index[i]:=Index[j]; Index[j]:=k;
    inc(i);
    dec(j);
   end;
  end;
  if l<j then Quick_Sort(l,j);
  if i<r then Quick_Sort(i,r);
 end;
 procedure Shell_Sort;
 var gap,i,j,k:Integer;
 begin
  gap:=N shr 1;
  while gap>0 do begin
   i:=gap;
   while i<N do begin
    j:=i-gap;
    while (j>=0) and (Key[Index[j+gap]]<Key[Index[j]]) do begin
     k:=Index[j]; Index[j]:=Index[j+gap]; Index[j+gap]:=k;
     dec(j,gap);
    end;
    inc(i);
   end;
   gap:=gap shr 1;
  end;
 end;
begin
 Result:=Index;
 if Assigned(Index) then begin
  for i:=0 to N-1 do Index[i]:=i;
  if N>1 then
  case Method of
   smShellSort: Shell_Sort;
   smQuickSort: Quick_Sort(0,N-1);
   else Shell_Sort;
  end;
 end;
end;

procedure QuickSortDoubleXY(N:integer; var x,y:array of double);
 procedure Sort(l, r: Integer);
 var
  i, j : integer;
  c, d : double;
 begin
  i := l;
  j := r;
  c := x[(l+r) shr 1];
  while (i<=j) do begin
    while x[i] < c do inc(i);
    while c < x[j] do dec(j);
    if i <= j then begin
      d := x[i]; x[i] := x[j]; x[j] := d;
      d := y[i]; y[i] := y[j]; y[j] := d;
      inc(i);
      dec(j);
    end;
  end;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
 end;
begin
 Sort(0,N-1);
end;

 {
 Fast binary search in sorted arrays
 }

function FindIndex(N:Integer; const x:array of Byte; at:Byte; index:PIntegerArray=nil):Integer;
var i,j,k,ik:Integer;
begin
 i:=0;
 j:=N-1;
 while j > i+1 do begin
  k:=(i+j) shr 1;
  if index=nil then ik:=k else ik:=index[k];
  if at < x[ik] then j:=k else i:=k;
 end;
 Result:=i;
end;
function FindIndex(N:Integer; const x:array of ShortInt; at:ShortInt; index:PIntegerArray=nil):Integer;
var i,j,k,ik:Integer;
begin
 i:=0;
 j:=N-1;
 while j > i+1 do begin
  k:=(i+j) shr 1;
  if index=nil then ik:=k else ik:=index[k];
  if at < x[ik] then j:=k else i:=k;
 end;
 Result:=i;
end;
function FindIndex(N:Integer; const x:array of Word; at:Word; index:PIntegerArray=nil):Integer;
var i,j,k,ik:Integer;
begin
 i:=0;
 j:=N-1;
 while j > i+1 do begin
  k:=(i+j) shr 1;
  if index=nil then ik:=k else ik:=index[k];
  if at < x[ik] then j:=k else i:=k;
 end;
 Result:=i;
end;
function FindIndex(N:Integer; const x:array of SmallInt; at:SmallInt; index:PIntegerArray=nil):Integer;
var i,j,k,ik:Integer;
begin
 i:=0;
 j:=N-1;
 while j > i+1 do begin
  k:=(i+j) shr 1;
  if index=nil then ik:=k else ik:=index[k];
  if at < x[ik] then j:=k else i:=k;
 end;
 Result:=i;
end;
function FindIndex(N:Integer; const x:array of LongWord; at:LongWord; index:PIntegerArray=nil):Integer;
var i,j,k,ik:Integer;
begin
 i:=0;
 j:=N-1;
 while j > i+1 do begin
  k:=(i+j) shr 1;
  if index=nil then ik:=k else ik:=index[k];
  if at < x[ik] then j:=k else i:=k;
 end;
 Result:=i;
end;
function FindIndex(N:Integer; const x:array of LongInt; at:LongInt; index:PIntegerArray=nil):Integer;
var i,j,k,ik:Integer;
begin
 i:=0;
 j:=N-1;
 while j > i+1 do begin
  k:=(i+j) shr 1;
  if index=nil then ik:=k else ik:=index[k];
  if at < x[ik] then j:=k else i:=k;
 end;
 Result:=i;
end;
function FindIndex(N:Integer; const x:array of Int64; at:Int64; index:PIntegerArray=nil):Integer;
var i,j,k,ik:Integer;
begin
 i:=0;
 j:=N-1;
 while j > i+1 do begin
  k:=(i+j) shr 1;
  if index=nil then ik:=k else ik:=index[k];
  if at < x[ik] then j:=k else i:=k;
 end;
 Result:=i;
end;
function FindIndex(N:Integer; const x:array of Single; at:Single; index:PIntegerArray=nil):Integer;
var i,j,k,ik:Integer;
begin
 i:=0;
 j:=N-1;
 while j > i+1 do begin
  k:=(i+j) shr 1;
  if index=nil then ik:=k else ik:=index[k];
  if at < x[ik] then j:=k else i:=k;
 end;
 Result:=i;
end;
function FindIndex(N:Integer; const x:array of Double; at:Double; index:PIntegerArray=nil):Integer;
var i,j,k,ik:Integer;
begin
 i:=0;
 j:=N-1;
 while j > i+1 do begin
  k:=(i+j) shr 1;
  if index=nil then ik:=k else ik:=index[k];
  if at < x[ik] then j:=k else i:=k;
 end;
 Result:=i;
end;
function FindIndex(N:Integer; const x:array of Comp; at:Comp; index:PIntegerArray=nil):Integer;
var i,j,k,ik:Integer;
begin
 i:=0;
 j:=N-1;
 while j > i+1 do begin
  k:=(i+j) shr 1;
  if index=nil then ik:=k else ik:=index[k];
  if at < x[ik] then j:=k else i:=k;
 end;
 Result:=i;
end;
function FindIndex(N:Integer; const x:array of Extended; at:Extended; index:PIntegerArray=nil):Integer;
var i,j,k,ik:Integer;
begin
 i:=0;
 j:=N-1;
 while j > i+1 do begin
  k:=(i+j) shr 1;
  if index=nil then ik:=k else ik:=index[k];
  if at < x[ik] then j:=k else i:=k;
 end;
 Result:=i;
end;

function isSortedArray(N:Integer; const x:array of Byte; Index:PIntegerArray; Eps:Byte=0; Revers:boolean=false):boolean;
var i,m,p:Integer;
begin
 Result:=true;
 if Revers then m:=1 else m:=0;
 p:=1-m;
 if Index=nil then begin
  for i:=1 to N-1 do if x[i-m]-x[i-p]<Eps then begin Result:=false; break; end
 end else begin
  for i:=1 to N-1 do if x[index[i-m]]-x[index[i-p]]<Eps then begin Result:=false; break; end
 end;
end;
function isSortedArray(N:Integer; const x:array of ShortInt; Index:PIntegerArray; Eps:ShortInt=0; Revers:boolean=false):boolean;
var i,m,p:Integer;
begin
 Result:=true;
 if Revers then m:=1 else m:=0;
 p:=1-m;
 if Index=nil then begin
  for i:=1 to N-1 do if x[i-m]-x[i-p]<Eps then begin Result:=false; break; end
 end else begin
  for i:=1 to N-1 do if x[index[i-m]]-x[index[i-p]]<Eps then begin Result:=false; break; end
 end;
end;
function isSortedArray(N:Integer; const x:array of Word; Index:PIntegerArray; Eps:Word=0; Revers:boolean=false):boolean;
var i,m,p:Integer;
begin
 Result:=true;
 if Revers then m:=1 else m:=0;
 p:=1-m;
 if Index=nil then begin
  for i:=1 to N-1 do if x[i-m]-x[i-p]<Eps then begin Result:=false; break; end
 end else begin
  for i:=1 to N-1 do if x[index[i-m]]-x[index[i-p]]<Eps then begin Result:=false; break; end
 end;
end;
function isSortedArray(N:Integer; const x:array of SmallInt; Index:PIntegerArray; Eps:SmallInt=0; Revers:boolean=false):boolean;
var i,m,p:Integer;
begin
 Result:=true;
 if Revers then m:=1 else m:=0;
 p:=1-m;
 if Index=nil then begin
  for i:=1 to N-1 do if x[i-m]-x[i-p]<Eps then begin Result:=false; break; end
 end else begin
  for i:=1 to N-1 do if x[index[i-m]]-x[index[i-p]]<Eps then begin Result:=false; break; end
 end;
end;
function isSortedArray(N:Integer; const x:array of LongWord; Index:PIntegerArray; Eps:LongWord=0; Revers:boolean=false):boolean;
var i,m,p:Integer;
begin
 Result:=true;
 if Revers then m:=1 else m:=0;
 p:=1-m;
 if Index=nil then begin
  for i:=1 to N-1 do if x[i-m]-x[i-p]<Eps then begin Result:=false; break; end
 end else begin
  for i:=1 to N-1 do if x[index[i-m]]-x[index[i-p]]<Eps then begin Result:=false; break; end
 end;
end;
function isSortedArray(N:Integer; const x:array of LongInt; Index:PIntegerArray; Eps:LongInt=0; Revers:boolean=false):boolean;
var i,m,p:Integer;
begin
 Result:=true;
 if Revers then m:=1 else m:=0;
 p:=1-m;
 if Index=nil then begin
  for i:=1 to N-1 do if x[i-m]-x[i-p]<Eps then begin Result:=false; break; end
 end else begin
  for i:=1 to N-1 do if x[index[i-m]]-x[index[i-p]]<Eps then begin Result:=false; break; end
 end;
end;
function isSortedArray(N:Integer; const x:array of Int64; Index:PIntegerArray; Eps:Int64=0; Revers:boolean=false):boolean;
var i,m,p:Integer;
begin
 Result:=true;
 if Revers then m:=1 else m:=0;
 p:=1-m;
 if Index=nil then begin
  for i:=1 to N-1 do if x[i-m]-x[i-p]<Eps then begin Result:=false; break; end
 end else begin
  for i:=1 to N-1 do if x[index[i-m]]-x[index[i-p]]<Eps then begin Result:=false; break; end
 end;
end;
function isSortedArray(N:Integer; const x:array of Single; Index:PIntegerArray; Eps:Single=0; Revers:boolean=false):boolean;
var i,m,p:Integer;
begin
 Result:=true;
 if Revers then m:=1 else m:=0;
 p:=1-m;
 if Index=nil then begin
  for i:=1 to N-1 do if x[i-m]-x[i-p]<Eps then begin Result:=false; break; end
 end else begin
  for i:=1 to N-1 do if x[index[i-m]]-x[index[i-p]]<Eps then begin Result:=false; break; end
 end;
end;
function isSortedArray(N:Integer; const x:array of Double; Index:PIntegerArray; Eps:Double=0; Revers:boolean=false):boolean;
var i,m,p:Integer;
begin
 Result:=true;
 if Revers then m:=1 else m:=0;
 p:=1-m;
 if Index=nil then begin
  for i:=1 to N-1 do if x[i-m]-x[i-p]<Eps then begin Result:=false; break; end
 end else begin
  for i:=1 to N-1 do if x[index[i-m]]-x[index[i-p]]<Eps then begin Result:=false; break; end
 end;
end;
function isSortedArray(N:Integer; const x:array of Comp; Index:PIntegerArray; Eps:Comp=0; Revers:boolean=false):boolean;
var i,m,p:Integer;
begin
 Result:=true;
 if Revers then m:=1 else m:=0;
 p:=1-m;
 if Index=nil then begin
  for i:=1 to N-1 do if x[i-m]-x[i-p]<Eps then begin Result:=false; break; end
 end else begin
  for i:=1 to N-1 do if x[index[i-m]]-x[index[i-p]]<Eps then begin Result:=false; break; end
 end;
end;
function isSortedArray(N:Integer; const x:array of Extended; Index:PIntegerArray; Eps:Extended=0; Revers:boolean=false):boolean;
var i,m,p:Integer;
begin
 Result:=true;
 if Revers then m:=1 else m:=0;
 p:=1-m;
 if Index=nil then begin
  for i:=1 to N-1 do if x[i-m]-x[i-p]<Eps then begin Result:=false; break; end
 end else begin
  for i:=1 to N-1 do if x[index[i-m]]-x[index[i-p]]<Eps then begin Result:=false; break; end
 end;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_sort;
begin
end;

procedure Free_crw_sort;
begin
end;

initialization

 Init_crw_sort;

finalization

 Free_crw_sort;

end.

//////////////
// END OF FILE
//////////////

