unit ArraySortingFunctions;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

//http://forum.lazarus-ide.org/index.php?topic=26457.0
// Topic: How to sort easely number ?

// http://wiki.lazarus.freepascal.org/Parameters
// Another way of passing parameters is call-by-reference. This creates a link between the formal parameter and the actual parameter.
// When the formal parameter is modified in the procedure, the actual parameter is likewise modified. Call-by-reference is activated by preceding the parameter group with a VAR
//
// "var" parameters are passed to the function by reference meaning that if the function changes the value of the parameter—a variable
// in the calling block of code—the function will change the value of the variable used for the parameter.

    procedure QuickSortDouble(var input_double_array: array of Double; iLo, iHi: Integer; var index_data_array: array of Integer);
    procedure PartialQuickerSortDouble(var data_array: array of Double; lower: Integer; upper: Integer; var index_data_array: array of Integer); register;
    procedure SedgeSortDouble(var data_array: array of Double; len: Integer; var index_data_array: array of Integer); register; // MAIN ENTRY INTO FAST SORTING (Fast sorting for random ordered data_arrays. The performance is slow for ordered data_arrays. Use e.g. "mergesort" for almost ordered data_arrays
    procedure InSortDouble(var data_array: array of Double; len: Integer; var index_data_array: array of Integer); register;

    procedure QuickSortInteger(var input_integer_array: array of Integer; iLo, iHi: Integer; var index_data_array: array of Integer);
    procedure PartialQuickerSortInteger(var data_array: array of Integer; lower: Integer; upper: Integer; var index_data_array: array of Integer); register;
    procedure SedgeSortInteger(var data_array: array of Integer; len: Integer; var index_data_array: array of Integer); register; // MAIN ENTRY INTO FAST SORTING (Fast sorting for random ordered data_arrays. The performance is slow for ordered data_arrays. Use e.g. "mergesort" for almost ordered data_arrays
    procedure InSortInteger(var data_array: array of Integer; len: Integer; var index_data_array: array of Integer); register;

const
  cut_off_quickersort: Integer = 15;

implementation




//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
procedure QuickSortDouble(var input_double_array: array of Double; iLo, iHi: Integer; var index_data_array: array of Integer);
var Lo, Hi, temp_integer: Integer;
    pivot, temp_double: Double;
begin
   if (iHi-iLo) <= 0 then exit;

   Lo := iLo;
   Hi := iHi;
   Pivot := input_double_array[(Lo + Hi) div 2];

   repeat
      while input_double_array[Lo] < Pivot do Inc(Lo);
      while input_double_array[Hi] > Pivot do Dec(Hi);

      if Lo <= Hi then
      begin
         temp_double := input_double_array[Lo];
         input_double_array[Lo] := input_double_array[Hi];
         input_double_array[Hi] := temp_double;

         temp_integer := index_data_array[Lo];
         index_data_array[Lo] := index_data_array[Hi];
         index_data_array[Hi] := temp_integer;


         Inc(Lo) ;
         Dec(Hi) ;
      end;
   until Lo > Hi;
   if Hi > iLo then QuickSortDouble(input_double_array, iLo, Hi, index_data_array) ;
   if Lo < iHi then QuickSortDouble(input_double_array, Lo, iHi, index_data_array) ;


end;

//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
{
Robert Sedgewick optimization. Use partial quickersort with a sentinel to reach a partial order,
leave the unsorted segments of length := cut_off_quickersort unsorted. Then apply a simpler one-pass
low-overhead insertion sort on the whole data_array to reach complete order. This method was found
empirically to be one of the fastest sorting methods in practice.
If you don't believe it, try to beat it. Note, worst cases are rare in big data_arrays, so to keep
the overhead to minimum, this sort does not try to avoid worst cases (e.g. using median of three
to select a random pivot).
}


    { 15 has been found empirically as the optimal cut_off_quickersort value }
//    const int  cut_off_quickersort := 15;


{
 |  void  PartialQuickerSortDouble (data_array, lower, upper)
 |  double  data_array[];
 |  int    lower, upper;
 |
 |  Abstract:
 |	Sort data_array[lower..upper] into a partial order
 |     	leaving segments which are cut_off_quickersort elements long
 |     	unsorted internally.
 |
 |  Efficiency:
 |	Could be made faster for _worst_ cases by selecting
 |	a pivot using median-of-3. I don't do it because
 |	in practical cases my pivot selection is arbitrary and
 |	thus pretty random, your mileage may vary.
 |
 |  Method:
 |	Partial Quicker-sort using a sentinel (ala Robert Sedgewick)
 |
 |  BIG NOTE:
 |	Precondition: data_array[upper+1] holds the maximum possible key.
 |	with a cut_off_quickersort value of cut_off_quickersort.
}
//---------------------------------------------------------------------------


//---------------------------------------------------------------------------
//procedure PartialQuickerSortDouble(register double *data_array, register int lower, register int upper, int *index_data_array)
procedure PartialQuickerSortDouble(var data_array: array of Double; lower: Integer; upper: Integer; var index_data_array: array of Integer); register;
var
  i, j: Integer; // register
  temp, pivot: Double; //register
  index_temp: Integer;

begin

    if (upper - lower > cut_off_quickersort) then
        begin

	temp := data_array[lower]; data_array[lower] := data_array[(upper+lower) div 2]; data_array[(upper+lower) div 2] := temp; //SWAP(data_array[lower], data_array[(upper+lower) div 2]);
        index_temp := index_data_array[lower]; index_data_array[lower] := index_data_array[(upper+lower) div 2]; index_data_array[(upper+lower) div 2] := index_temp; //SWAP(data_array[lower], data_array[(upper+lower) div 2]);
	i := lower;  j := upper + 1;  pivot := data_array[lower];
	while (True) do
        begin

	     // ------------------------- NOTE --------------------------
	     // ignoring BIG NOTE above may lead to an infinite loop here
	     // ---------------------------------------------------------

	    repeat Inc(i); until not (data_array[i] < pivot);
	    repeat Dec(j); until not (data_array[j] > pivot);
	    if (j < i) then break;
	    temp := data_array[i]; data_array[i] := data_array[j]; data_array[j] := temp; // SWAP(data_array[i], data_array[j]);
            index_temp := index_data_array[i]; index_data_array[i] := index_data_array[j]; index_data_array[j] := index_temp; // SWAP(data_array[i], data_array[j]);
 	end;

	temp := data_array[lower]; data_array[lower] := data_array[j]; data_array[j] := temp; //SWAP(data_array[lower], data_array[j]);
        index_temp := index_data_array[lower]; index_data_array[lower] := index_data_array[j]; index_data_array[j] := index_temp; //SWAP(data_array[lower], data_array[j]);
	PartialQuickerSortDouble (data_array, lower, (j - 1), index_data_array);
	PartialQuickerSortDouble (data_array, i, upper, index_data_array);
    end;

end;


{
 |  Abstract:
 |	Sort data_array[0..len-1] into increasing order.
 |
 |  Method:
 |	Use PartialQuickerSortDouble() with a sentinel (ala Sedgewick)
 |	to reach a partial order, leave the unsorted segments of
 |	length := cut_off_quickersort to a simpler low-overhead, insertion sort.
 |
 |	This method seems to me the ultimative sort method in terms
 |	of average efficiency (Skeptic ? try to beat it).
 |
 |  BIG NOTE:
 |	precondition: data_array[len] must hold a sentinel (largest
 |	possible value) in order for this to work correctly.
 |	An easy way to do this is to declare an data_array that has
 | 	len+1 elements [0..len], and assign MAXINT or some such
 |	to the last location before starting the sort (see sorttest.c)
 }

//---------------------------------------------------------------------------


//procedure SedgeSortDouble(register double *data_array, register int len, int *index_data_array) // MAIN ENTRY INTO FAST SORTING (Fast sorting for random ordered data_arrays. The performance is slow for ordered data_arrays. Use e.g. "mergesort" for almost ordered data_arrays
procedure SedgeSortDouble(var data_array: array of Double; len: Integer; var index_data_array: array of Integer); register;
begin
    {
     * ------------------------- NOTE --------------------------
     * ignoring BIG NOTE above may lead to an infinite loop here
     * ---------------------------------------------------------
     }

    PartialQuickerSortDouble(data_array, 0, (len - 1), index_data_array);
    InSortDouble(data_array, len, index_data_array);


end;



{
   Abstract:	Sort data_array[0..len-1] into increasing order.
   Method:	Optimized insertion-sort (ala Jon Bentley)
}

//---------------------------------------------------------------------------
//procedure InSortDouble(register double *data_array, register int len, int *index_data_array)
procedure InSortDouble(var data_array: array of Double; len: Integer; var index_data_array: array of Integer); register;
var
  i, j: Integer; // register
  temp: Double; // register
  index_temp: Integer;

begin

	for i := 1 to len-1 do
        begin
		{ invariant:  data_array[0..i-1] is sorted }
		j := i;
		temp := data_array[j];
		index_temp := index_data_array[j];
		while ((j > 0) and (data_array[j-1] > temp)) do
                begin
			data_array[j] := data_array[j-1];
			index_data_array[j] := index_data_array[j-1];
			Dec(j);
		end;
		data_array[j] := temp;
		index_data_array[j] := index_temp;
	end;

end;


//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------


//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
procedure QuickSortInteger(var input_integer_array: array of Integer; iLo, iHi: Integer; var index_data_array: array of Integer) ;
var Lo, Hi, temp_integer: Integer;
    pivot, temp_double: Integer;
begin
   if (iHi-iLo) <= 0 then exit;

   Lo := iLo;
   Hi := iHi;
   Pivot := input_integer_array[(Lo + Hi) div 2];

   repeat
      while input_integer_array[Lo] < Pivot do Inc(Lo);
      while input_integer_array[Hi] > Pivot do Dec(Hi);

      if Lo <= Hi then
      begin
         temp_double := input_integer_array[Lo];
         input_integer_array[Lo] := input_integer_array[Hi];
         input_integer_array[Hi] := temp_double;

         temp_integer := index_data_array[Lo];
         index_data_array[Lo] := index_data_array[Hi];
         index_data_array[Hi] := temp_integer;

         Inc(Lo) ;
         Dec(Hi) ;
      end;
   until Lo > Hi;
   if Hi > iLo then QuickSortInteger(input_integer_array, iLo, Hi, index_data_array) ;
   if Lo < iHi then QuickSortInteger(input_integer_array, Lo, iHi, index_data_array) ;

end;



//---------------------------------------------------------------------------
//procedure PartialQuickerSortInteger(register int *data_array, register int lower, register int upper, int *index_data_array)
procedure PartialQuickerSortInteger(var data_array: array of Integer; lower: Integer; upper: Integer; var index_data_array: array of Integer); register;
var
  i, j: Integer; //register
  temp, pivot: Integer;  //register
  index_temp: Integer;

begin

    if (upper - lower > cut_off_quickersort) then
    begin

	temp := data_array[lower]; data_array[lower] := data_array[(upper+lower) div 2]; data_array[(upper+lower) div 2] := temp; //SWAP(data_array[lower], data_array[(upper+lower) div 2]);
        index_temp := index_data_array[lower]; index_data_array[lower] := index_data_array[(upper+lower) div 2]; index_data_array[(upper+lower) div 2] := index_temp; //SWAP(data_array[lower], data_array[(upper+lower) div 2]);
	i := lower;  j := upper + 1;  pivot := data_array[lower];
	while (True) do
        begin

	     // ------------------------- NOTE --------------------------
	     // ignoring BIG NOTE above may lead to an infinite loop here
	     // ---------------------------------------------------------

	    repeat Inc(i); until not (data_array[i] < pivot);
	    repeat Dec(j); until not (data_array[j] > pivot);
	    if (j < i) then break;
	    temp := data_array[i]; data_array[i] := data_array[j]; data_array[j] := temp; // SWAP(data_array[i], data_array[j]);
            index_temp := index_data_array[i]; index_data_array[i] := index_data_array[j]; index_data_array[j] := index_temp; // SWAP(data_array[i], data_array[j]);
 	end;
	temp := data_array[lower]; data_array[lower] := data_array[j]; data_array[j] := temp; //SWAP(data_array[lower], data_array[j]);
        index_temp := index_data_array[lower]; index_data_array[lower] := index_data_array[j]; index_data_array[j] := index_temp; //SWAP(data_array[lower], data_array[j]);
	PartialQuickerSortInteger (data_array, lower, (j - 1), index_data_array);
	PartialQuickerSortInteger (data_array, i, upper, index_data_array);
    end;

end;


{
 |  Abstract:
 |	Sort data_array[0..len-1] into increasing order.
 |
 |  Method:
 |	Use PartialQuickerSortInteger() with a sentinel (ala Sedgewick)
 |	to reach a partial order, leave the unsorted segments of
 |	length := cut_off_quickersort to a simpler low-overhead, insertion sort.
 |
 |	This method seems to me the ultimative sort method in terms
 |	of average efficiency (Skeptic ? try to beat it).
 |
 |  BIG NOTE:
 |	precondition: data_array[len] must hold a sentinel (largest
 |	possible value) in order for this to work correctly.
 |	An easy way to do this is to declare an data_array that has
 | 	len+1 elements [0..len], and assign MAXINT or some such
 |	to the last location before starting the sort (see sorttest.c)
 }

//---------------------------------------------------------------------------
//procedure SedgeSortInteger(register int *data_array, register int len, int *index_data_array) // MAIN ENTRY INTO FAST SORTING (Fast sorting for random ordered data_arrays. The performance is slow for ordered data_arrays. Use e.g. "mergesort" for almost ordered data_arrays
procedure SedgeSortInteger(var data_array: array of Integer; len: Integer; var index_data_array: array of Integer);  register; // MAIN ENTRY INTO FAST SORTING (Fast sorting for random ordered data_arrays. The performance is slow for ordered data_arrays. Use e.g. "mergesort" for almost ordered data_arrays
begin

     // ------------------------- NOTE --------------------------
     // ignoring BIG NOTE above may lead to an infinite loop here
     // ---------------------------------------------------------

    PartialQuickerSortInteger(data_array, 0, (len - 1), index_data_array);
    InSortInteger(data_array, len, index_data_array);
end;




//   Abstract:	Sort data_array[0..len-1] into increasing order.
//   Method:	Optimized insertion-sort (ala Jon Bentley)


//---------------------------------------------------------------------------
//procedure InSortInteger(register int *data_array, register int len, int *index_data_array)
procedure InSortInteger(var data_array: array of Integer; len: Integer; var index_data_array: array of Integer); register;
var
  i, j: Integer; //register
  temp: Integer; //register
  index_temp: Integer;

begin
	for i := 1 to len-1 do
        begin
		// invariant:  data_array[0..i-1] is sorted
		j := i;
		temp := data_array[j];
		index_temp := index_data_array[j];
		while ((j > 0) and (data_array[j-1] > temp)) do
                begin
			data_array[j] := data_array[j-1];
			index_data_array[j] := index_data_array[j-1];
			Dec(j);
		end;
		data_array[j] := temp;
		index_data_array[j] := index_temp;
	end;

end;

//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------


end.

