unit Sort;

interface
uses Classes;
type
  TCompare = (lt, gt, eq, ltOeq);

  TCompareFunction = function(const AItemA:Pointer;
                              const AShouldBe:TCompare;
                              const AItemB:Pointer):Boolean;

  TCustomSort = class
  private
    FSortLoopCount : Integer;
    FList : TList;
    FCompare : TCompareFunction;
  protected
    procedure IncSortLoopCount;
  public
    constructor Create; virtual;
    //Sort implements the sorting algorithm
    procedure Sort; virtual; abstract;
    function SortAlgorithmCorrect : Boolean;
    property List : TList read FList write FList;
    property Compare : TCompareFunction
                       read FCompare write FCompare;
    property SortLoopCount : Integer read FSortLoopCount;
  published
  end;

  TSelectSort = class(TCustomSort)
  public
    procedure Sort; override;
  end;

  TInsertSort = class(TCustomSort)
  public
    procedure Sort; override;
  end;

  TBubbleSort = class(TCustomSort)
  public
    procedure Sort; override;
  end;

  TBiDirectionalBubbleSort = class(TCustomSort)
  public
    procedure Sort; override;
  end;

  TShakerSort = class(TCustomSort)
  public
    procedure Sort; override;
  end;

implementation

constructor TCustomSort.Create;
begin
  FList := nil;
  FCompare := nil;
  FSortLoopCount := 0;
end;

procedure TCustomSort.IncSortLoopCount;
begin
  inc(FSortLoopCount);
end;

function TCustomSort.SortAlgorithmCorrect : Boolean;
var i : Integer;
begin
  if Assigned(List) and Assigned(Compare) then
  begin
    for i := 0 to List.Count - 2 do
    begin
      Result := Compare(List[i], ltOeq, List[i+1]);
      if not Result Then Break;
    end;
  end;
end;

procedure TSelectSort.Sort;
var i, j : Integer;
    h : Pointer;
begin
  if Assigned(List) and Assigned(Compare) then
  begin
    for i := 0 to List.Count - 2 do
    begin
      for j := i + 1 to List.Count - 1 do
      begin
        if Compare(List[i], gt, List[j]) then
        begin
          h := List[i];
          List[i] := List[j];
          List[j] := h;
        end;
        IncSortLoopCount;
      end;
    end;
  end;
end;

procedure TInsertSort.Sort;
var i, j : Integer;
    h : Pointer;
begin
  if Assigned(List) and Assigned(Compare) then
  begin
    for i := 1 to List.Count - 1 do
    begin
      h := List[i];
      j := i;
      while (j > 0) and Compare(List[j-1], gt, h) do
      begin
        List[j] := List[j-1];
        dec(j);
        IncSortLoopCount;
      end;
      List[j] := h;
    end;
  end;
end;

procedure TBubbleSort.Sort;
var i, j : Integer;
    h : Pointer;
    flipped : Boolean;
begin
  if Assigned(List) and Assigned(Compare) then
  begin
    for i := 1 to List.Count - 1 do
    begin
      flipped := false;
      for j := List.Count - 1 downto i do
      begin
        if Compare(List[j-1], gt, List[j]) then
        begin
          h := List[j-1];
          List[j-1] := List[j];
          List[j] := h;
        end;
        IncSortLoopCount;
      end;
      if not flipped then
        Break;
    end;
  end;
end;

procedure TBiDirectionalBubbleSort.Sort;
var i, j, start : Integer;
    flipped : Boolean;
    h : Pointer;
begin
  j := List.Count - 1;
  start := -1;
  while start < j do
  begin
    flipped := false;
    inc(start);
    dec(j);
    for i := start to j-1 do
    begin
      if Compare(List[i], gt, List[i+1]) then
      begin
        h := List[i];
        List[i] := List[i+1];
        List[i+1] := h;
        flipped := true;
      end;
      IncSortLoopCount;
    end;
    if not flipped then
      Break;

    for i := j downto start do
    begin
      if Compare(List[i], gt, List[i+1]) then
      begin
        h := List[i];
        List[i] := List[i+1];
        List[i+1] := h;
        flipped := true;
      end;
      IncSortLoopCount;
    end;
    if not flipped then
      Break;
  end;
end;

procedure TShakerSort.Sort;
var i, j, k : Integer;
    min, max : Integer;
    h : Pointer;
begin
  i := 0;
  k := List.Count - 1;
  while i < k do
  begin
    min := i;
    max := i;
    for j := i + 1 to k do
    begin
      if Compare(List[j], lt, List[min]) then
        min := j;

      if Compare(List[j], gt, List[max]) then
        max := j;
    end;

    h := List[min];
    List[min] := List[i];
    List[i] := h;

    if max = i then
    begin
      h := List[min];
      List[min] := List[k];
      List[k] := h;
    end
    else
    begin
      h := List[max];
      List[max] := List[k];
      List[k] := h;
    end;
    inc(i);
    dec(k);
  end;
end;

end.