program Quick_Shell_Sort;
{$APPTYPE CONSOLE}
uses
  SysUtils;

This line must be commented out by adding //. By commenting out this line you
// will modify the source and therefore take full responsibility for this document/code as used
// by you.

// You may not publish or in any other way make this document or code or copy thereof
// available to the public without QxSource written consent.
// You or your organization may in other ways use this code or information to your benefit.

// QxSource is the sole owner of this document. By using this document you acknowledge that:
// A) QxSource is in no way responsible for this document's/code's use or functionality.
// B) QxSource is in no way responsible for damage caused by any use of this document/code
// or it's functionality.
// C) QxSource provides no warranties for the contents, functionality or use of this document.
// D) This document is provided as is for educational purpose only.

//We wish you the best use of this educational information.
//====================================================================



const MAXLIST = 100000;
type TArray = array[0..MAXLIST-1] of Integer;
type TArrayP = ^TArray;
var RecCnt:Int64;



//=================================================
// ShellSort non recursive sort
//
procedure ShellSort(var List:Tarray; Asize:Integer);
var i,k,Offset,LoopLimit,Switch,tmp:Integer;
begin
   k := 1;
   repeat
     k := 3 * k + 1; // x3 is uneven and nice to not cmp same vals
   until k > Asize;

   Offset := {Asize} k div 3; //Work on h=h*3+1....
   while Offset > 0 do // if offset is 0 => done! (offset /=2...see below)
   begin
     LoopLimit := Asize - Offset; //First time ~List/3...
     repeat
     begin
       Switch := -1; //-1 to show no swaps done
       for i := 0 to LoopLimit-1 do //LoopLimit~ Switch-Offset+1
       begin
         //inc(cnt);
         if List[i] > List[i+Offset] then //Distant compare
         begin //Swap
           tmp:=List[i];
           List[i] := List[i+Offset];
           List[i+Offset] := tmp;
           Switch := i
         end;
       end;                          //if negative none will be done
       LoopLimit := Switch-Offset+1; //Redo up till second to last swap
     end;
     until Switch < 0;  //no swaps done
     Offset := Offset div 3; //shrink offset so ..looks like std bubble @ end
   end;
end; //End ShellSort


//=================================================
// QuickSort recursive sort
//
procedure QuickSort(var List: TArray; Low, High: integer);
var LowIx, HighIx, tmp, PivotVal: integer;
begin
  Inc(RecCnt);

  // If you want plain Quicksort remove the code
  // below if RecCnt > 30 then
  if RecCnt > 30 then
  begin //Used to stop deep recusion
    ShellSort( TArrayP( @List[Low] )^ , High+1-Low);
    exit;
  end;

  //cnt:=max(cnt,RecCnt); //So we can show max recusion
  LowIx:=Low; //Index moving, Low-> PivotVal
  HighIx:=High; //Index moving, High-> PivotVal

  PivotVal:=List[(Low+High) div 2]; //Get PivotVal

  while LowIx <= HighIx do
  begin
    while List[LowIx] < PivotVal do
     inc(LowIx); //Move LowIn up...
    while List[HighIx] > PivotVal do
     dec(HighIx); //Move HighIx up...

    if (LowIx <= HighIx) then
    begin //Indexes did not meet so swap...
      tmp := List[LowIx];
      List[LowIx] := List[HighIx];
      List[HighIx] := tmp;
      inc(LowIx);
      dec(HighIx);
    end;
  end;

  // Recursive Calls
  if Low < HighIx then QuickSort(List, Low, HighIx);
  if LowIx < High then QuickSort(List, LowIx, High);
  Dec(RecCnt);
end; //End QuickSort

//=================================================
// BubbleSort not used
//
procedure BubbleSort(var List:Tarray; Asize:Integer);
var i,j,tmp:Integer;
begin
  for i:=0 to Asize-2 do   //Loop by all members
    for j:=i+1 to Asize-1 do  //Loop from i to all members
    begin
      //inc (Cnt);
      if List[i] > List[j] then
      begin  //If bottom [i] is > move it up
        tmp := List[i];
        List[i] := List[j];
        List[j] := tmp;
      end;
    end;
end;

//
//=================================================





var List:TArray;

var x:Integer;
var Ok:Boolean;
begin
  Ok := True;
  Randomize;
  for x:=1 to MAXLIST do
    List[x-1]:= Random(50000);


  QuickSort(List, 0, MAXLIST);

  for x:=0 to MAXLIST-2 do
    if List[x] > List[x+1] then
    begin
      Writeln('Bad sort');
      Ok := False;
      break;
    end;

  if Ok then
      Writeln('Ok! Sorted: ' + IntToStr(MAXLIST) + ' Integers');


end.