Array Sorting

{$loadlib MIMUPlugin.dll}

procedure SelectionSort(var arr: TIntegerArray);
var
  m, c, h, t: Integer;
begin
  for c := 0 to h do
  begin
    m := c;
    for t := (c + 1) to h do
      if (arr[m] < arr[t]) then
        m := t;
    Swap(arr[m], arr[c]);
  end;
end;

procedure BubbleSort(var arr: TIntegerArray);
var
  h, j, b, a: Integer;
begin
  if (mAssign(h, High(arr)) > 0) then
  begin
    j := (h - 1);
    for a := 0 to j do
      for b := 1 to h do
        if (arr[(b - 1)] > arr[b]) then
          Swap(arr[(b - 1)], arr[b]);
  end;
end;

procedure ShellSort(var arr: TIntegerArray);
var
  l, z, x, b, a: Integer;
begin
  if (mAssign(l, Length(arr)) > 1) then
  begin
    z := (l - 1);
    x := 0;
    while (x < (l div 3)) do
      x := ((x * 3) + 1);
    case (l > 2) of
      True:
      while (x >= 1) do
      begin
        for a := x to z do
        begin
          b := a;
          while ((b >= x) and (arr[b] < arr[(b - x)])) do
          begin
            Swap(arr[b], arr[(b - x)]);
            b := (b - x);
          end;
        end;
        x := (x div 3);
      end;
      False:
      if (arr[0] > arr[1]) then
        Swap(arr[0], arr[1]);
    end;
  end;
end;

procedure InsertionSort(var arr: TIntegerArray);
var
  h, a, b: Integer;
begin
  if (mAssign(h, High(arr)) > 0) then
  for a := 1 to h do
    for b := a downto 1 do
      if (arr[(b - 1)] > arr[b]) then
        Swap(arr[(b - 1)], arr[b])
      else
        Break;
end;

procedure DivisionSort(var arr: TIntegerArray);
var
  l, h, i, c: Integer;
  s: Boolean;
begin
  l := Length(arr);
  if (l > 1) then
  begin
    c := (l - 1);
    while (c > 0) do
    begin
      s := False;
      for i := 0 to (l - (c + 1)) do
        if (arr[i] > arr[(i + c)]) then
        begin
          Swap(arr[i], arr[(i + c)]);
          s := True;
        end;
      if not s then
        c := (c div 2);
    end;
  end;
end;

procedure DivisionSortII(var arr: TIntegerArray);
var
  l, h, i, c: Integer;
  s: Boolean;
begin
  l := Length(arr);
  if (l > 1) then
  begin
    c := (l - 1);
    while (c > 0) do
    begin
      s := False;
      for i := 0 to (l - (c + 1)) do
        if (arr[i] > arr[(i + c)]) then
        begin
          Swap(arr[i], arr[(i + c)]);
          s := True;
        end;
      if not s then
        c := (c div 2)
      else
        c := (c * 2);
    end;
  end;
end;

procedure DivSort(var arr: TIntegerArray);
var
  l, h, i, c: Integer;
  s: Boolean;
begin
  l := Length(arr);
  if (l > 1) then
  begin
    c := (l div 2);
    while (c > 0) do
    begin
      s := False;
      for i := 0 to (l - (c + 1)) do
        if (arr[i] > arr[(i + c)]) then
        begin
          Swap(arr[i], arr[(i + c)]);
          s := True;
        end;
      if not s then
        c := (c div 2);
    end;
  end;
end;

procedure DivSortII(var arr: TIntegerArray);
var
  l, h, i, c: Integer;
  s: Boolean;
begin
  l := Length(arr);
  if (l > 1) then
  begin
    c := (l div 2);
    while (c > 0) do
    begin
      s := False;
      for i := 0 to (l - (c + 1)) do
        if (arr[i] > arr[(i + c)]) then
        begin
          Swap(arr[i], arr[(i + c)]);
          s := True;
        end;
      if not s then
        c := (c div 2)
      else
        c := (c * 2);
    end;
  end;
end;

procedure DivideSort(var arr: TIntegerArray);
var
  l, h, i, c: Integer;
  s: Boolean;
begin
  l := Length(arr);
  s := (l > 1);
  while s do
  begin
    c := (l - 1);
    s := False;
    while (c > 0) do
    begin
      for i := 0 to (l - (c + 1)) do
        if (arr[i] > arr[(i + c)]) then
        begin
          Swap(arr[i], arr[(i + c)]);
          s := True;
        end;
      c := (c div 2);
    end;
  end;
end;

procedure DivideSortII(var arr: TIntegerArray);
var
  l, h, i, c: Integer;
  s: Boolean;
begin
  l := Length(arr);
  s := (l > 1);
  while s do
  begin
    c := (l div 2);
    s := False;
    while (c > 0) do
    begin
      for i := 0 to (l - (c + 1)) do
        if (arr[i] > arr[(i + c)]) then
        begin
          Swap(arr[i], arr[(i + c)]);
          s := True;
        end;
      c := (c div 2);
    end;
  end;
end;

procedure ZoomSort(var arr: TIntegerArray);
var
  l, h, i, c: Integer;
begin
  l := Length(arr);
  for c := (l - 1) downto 1 do
    for i := 0 to (l - (c + 1)) do
      if (arr[i] > arr[(i + c)]) then
        Swap(arr[i], arr[(i + c)]);
end;

procedure QuickSort2(var arr: TIntegerArray; Lo, Hi: Integer); overload;
var
  A, L, R, C, T: Integer;
begin
  repeat
    case ((Hi - Lo) > 16) of
      True:
      begin
        C := arr[((Hi + Lo) shr 1)];
        L := Lo;
        R := Hi;
        repeat
          while (arr[L] < C) do
            Inc(L);
          while (arr[R] > C) do
            Dec(R);
          if (L <= R) then
          begin
            if (L <> R) then
            begin
              T := arr[L];
              arr[L] := arr[R];
              arr[R] := T;
            end;
            Inc(L);
            Dec(R);
          end;
        until (R < L);
        if (R > Lo) then
          mQuickSortII(arr, Lo, R);
        Lo := L;
      end;
      False:
      begin
        A := (Lo + 1);
        for L := A to Hi do
        begin
          T := arr[L];
          R := L;
          while ((R > Lo) and (arr[(R - 1)] > T)) do
          begin
            arr[R] := arr[(R - 1)];
            Dec(R);
          end;
          arr[R] := T;
        end;
        Exit;
      end;
    end;
  until (Hi <= L);
end;

procedure QuickSort2(var arr: TIntegerArray); overload;
var
  h: Integer;
begin
  if (mAssign(h, High(arr)) > 0) then
    QuickSort2(arr, 0, h);
end;

var
  i, j, k, t: Integer;
  x, y, z: TIntegerArray;
  n: TStringArray;
  a, b, c: string;

begin
  ClearDebug;
  n := ['ShellSort', 'QuickSort2', 'DivisionSort', 'DivSort', 'DivSortII', 'DivideSort', 'DivisionSortII', 'DivideSortII', 'ZoomSort'];
  for i := 9999 downto 0 do
  begin
    x := mRandom(RandomRange(-9999, -5000), RandomRange(5000, 9999), RandomRange(10, 15), True);
    mQuickSortII(x);
    a := MD5(ToStr(x));
    for j := 0 to 2 do
    begin
      case j of
        0:
        begin
          c := '';
          for k := 2 to 8 do
          begin
            y := mClone(x);
            t := GetSystemTime;
            case k of
              0: ShellSort(y);
              1: QuickSort2(y);
              2: DivisionSort(y);
              3: DivSort(y);
              4: DivSortII(y);
              5: DivideSort(y);
              6: DivisionSortII(y);
              7: DivideSortII(y);
              8: ZoomSort(y);
            end;
            b := MD5(ToStr(y));
            if (a <> b) then
            begin
              WriteLn(n[k], ' FAILED.');
              TerminateScript;
            end;
            c := (c + ' ' + ToStr(GetSystemTime - t) + ' ms. [' + n[k] + ']');
            SetLength(y, 0);
          end;
          WriteLn('SORTED (', Length(x), '):' + c);
        end;
        1:
        begin
          z := mReversed(x);
          c := '';
          for k := 2 to 8 do
          begin
            y := mClone(z);
            t := GetSystemTime;
            case k of
              0: ShellSort(y);
              1: QuickSort2(y);
              2: DivisionSort(y);
              3: DivSort(y);
              4: DivSortII(y);
              5: DivideSort(y);
              6: DivisionSortII(y);
              7: DivideSortII(y);
              8: ZoomSort(y);
            end;
            b := MD5(ToStr(y));
            if (a <> b) then
            begin
              WriteLn(n[k], ' FAILED.');
              TerminateScript;
            end;
            c := (c + ' ' + ToStr(GetSystemTime - t) + ' ms. [' + n[k] + ']');
            SetLength(y, 0);
          end;
          WriteLn('REVERSED (', Length(x), '):' + c);
        end;
        2:
        begin
          z := mClone(x);
          mRandomize(z);
          c := '';
          for k := 2 to 8 do
          begin
            y := mClone(z);
            t := GetSystemTime;
            case k of
              0: ShellSort(y);
              1: QuickSort2(y);
              2: DivisionSort(y);
              3: DivSort(y);
              4: DivSortII(y);
              5: DivideSort(y);
              6: DivisionSortII(y);
              7: DivideSortII(y);
              8: ZoomSort(y);
            end;
            b := MD5(ToStr(y));
            if (a <> b) then
            begin
              WriteLn(n[k], ' FAILED.');
              TerminateScript;
            end;
            c := (c + ' ' + ToStr(GetSystemTime - t) + ' ms. [' + n[k] + ']');
            SetLength(y, 0);
          end;
          WriteLn('SHUFFLED (', Length(x), '):' + c);
        end;
      end;
    end;
    WriteLn('');
  end;
  WriteLn('NO issues. :)');
end.