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 SortAlg10(var arr: TIntegerArray);
var
  l, h, i, c, s, d: Integer;
begin
  l := Length(arr);
  if (l > 1) then
  begin
    d := 2;
    c := l;
    while (c > 0) do
    begin
      s := 0;
      for i := 0 to (l - c) do
        if (arr[i] > arr[(i + c)]) then
        begin
          Swap(arr[i], arr[(i + c)]);
          s := (s + 1);
        end;
      if (s = 0) then
      begin
        c := (c div d);
        d := (d + 1);
      end;
    end;
  end;
end;

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

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

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

procedure SortAlg6(var arr: TIntegerArray);
var
  l, h, i, c: Integer;
  s: Boolean;
begin
  l := Length(arr);
  if (l > 1) then
  begin
    c := l;
    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 SortAlg5(var arr: TIntegerArray);
var
  l, h, i, j, c, d: Integer;
begin
  h := High(arr);
  if (h < 1) then
    Exit;
  case (h > 1) of
    True:
    for j := 1 to 2 do
      for i := 0 to (h - j) do
        if (arr[i] > arr[(i + j)]) then
          Swap(arr[i], arr[(i + j)]);
    False:
    if (arr[0] > arr[1]) then
      Swap(arr[0], arr[1]);
  end;
end;

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

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

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

procedure SortAlg3(var arr: TIntegerArray);
var
  l, h, i, c: Integer;
  s: Boolean;
begin
  l := Length(arr);
  if (l > 1) then
  for c := (l div 2) downto 1 do
  begin
    for i := 0 to (l - 1) do
    begin
      s := (arr[i] > arr[(i + 1)]);
      if s then
        Break;
    end;
    if not s then
      Break;
    for i := 0 to (l - c) do
      if (arr[i] > arr[(i + c)]) then
        Swap(arr[i], arr[(i + c)]);
  end;
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', 'SortAlg6', 'SortAlg7', 'SortAlg8', 'SortAlg9'];
  for i := 0 to 999 do
  begin
    x := mRandom(RandomRange(-9999, -5000), RandomRange(5000, 9999), RandomRange(5000, 25000), True);
    mQuickSortII(x);
    a := MD5(ToStr(x));
    for j := 0 to 2 do
    begin
      case j of
        0:
        begin
          c := '';
          for k := 0 to 5 do
          begin
            y := mClone(x);
            t := GetSystemTime;
            case k of
              0: ShellSort(y);
              1: QuickSort2(y);
              2: SortAlg6(y);
              3: SortAlg7(y);
              4: SortAlg8(y);
              5: SortAlg9(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 := 0 to 5 do
          begin
            y := mClone(z);
            t := GetSystemTime;
            case k of
              0: ShellSort(y);
              1: QuickSort2(y);
              2: SortAlg6(y);
              3: SortAlg7(y);
              4: SortAlg8(y);
              5: SortAlg9(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 := 0 to 5 do
          begin
            y := mClone(z);
            t := GetSystemTime;
            case k of
              0: ShellSort(y);
              1: QuickSort2(y);
              2: SortAlg6(y);
              3: SortAlg7(y);
              4: SortAlg8(y);
              5: SortAlg9(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.