Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {$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) 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) 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) 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, 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) 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 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(-55500, 55500, RandomRange(50000, 100000), 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.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement