//主要参考:https://blog.csdn.net/dbyoung/article/details/8086618
https://www.cnblogs.com/onepixel/articles/7674659.html
unit unit2;
interface
// 冒泡排序
procedure BubbleSort(var abc: array of Integer);
// 摇动排序
procedure ShakerSort(var abc: array of Integer);
// 梳子排序
procedure CombSort(var abc: array of Integer);
// 选择排序
procedure SelectionSort(var abc: array of Integer);
// 标准插入排序
procedure InsertionSortStd(var abc: array of Integer);
// 优化的插入排序
procedure InsertionSort(var abc: array of Integer);
// 希尔排序
procedure ShellSort(var abc: array of Integer);
// 标准归并排序
procedure MergeSortStd(var abc: array of Integer);
// 优化的归并排序
procedure MergeSort(var abc: array of Integer);
// 标准快速排序
procedure QuickSortStd(var abc: array of Integer);
// 无递归的快速排序
procedure QuickSortNoRecurse(var abc: array of Integer);
// 随机的快速排序
procedure QuickSortRandom(var abc: array of Integer);
// 中间值的快速排序
procedure QuickSortMedian(var abc: array of Integer);
// 优化的插入快速排序
procedure QuickSort(var abc: array of Integer);
// 堆排序
procedure HeapSort(var abc: array of Integer);
implementation
// 冒泡排序
procedure BubbleSort(var abc: array of Integer);
var
i, j: Integer;
Temp: Integer;
Done: boolean;
begin
for i := 0 to High(abc) do
begin
Done := true;
for j := High(abc) + 1 downto 0 do
if abc[j] < abc[j - 1] then
begin
Temp := abc[j];
abc[j] := abc[j - 1];
abc[j - 1] := Temp;
Done := false;
end;
if Done then
Exit;
end;
end;
// 梳子排序
procedure CombSort(var abc: array of Integer);
var
i, j: Integer;
Temp: Integer;
Done: boolean;
Gap: Integer;
begin
Gap := High(abc);
repeat
Done := true;
Gap := (longint(Gap) * 10) div 13;
if (Gap < 1) then
Gap := 1
else if (Gap = 9) or (Gap = 10) then
Gap := 11;
for i := 0 to (High(abc) - Gap) do
begin
j := i + Gap;
if abc[j] < abc[i] then
begin
Temp := abc[j];
abc[j] := abc[i];
abc[i] := Temp;
Done := false;
end;
end;
until Done and (Gap = 1);
end;
// 标准插入排序
procedure InsertionSortStd(var abc: array of Integer);
var
i, j: Integer;
Temp: Integer;
begin
for i := 0 to High(abc) do
begin
Temp := abc[i];
j := i;
while (j > 0) and (Temp < abc[j - 1]) do
begin
abc[j] := abc[j - 1];
dec(j);
end;
abc[j] := Temp;
end;
end;
// 优化的插入排序
procedure InsertionSort(var abc: array of Integer);
var
i, j: Integer;
IndexOfMin: Integer;
Temp: Integer;
begin
IndexOfMin := 0;
for i := 0 to High(abc) do
if abc[i] < abc[IndexOfMin] then
IndexOfMin := i;
if (0 <> IndexOfMin) then
begin
Temp := abc[0];
abc[0] := abc[IndexOfMin];
abc[IndexOfMin] := Temp;
end;
for i := 0 + 2 to High(abc) do
begin
Temp := abc[i];
j := i;
while Temp < abc[j - 1] do
begin
abc[j] := abc[j - 1];
dec(j);
end;
abc[j] := Temp;
end;
end;
// 选择排序
procedure SelectionSort(var abc: array of Integer);
var
i, j: Integer;
IndexOfMin: Integer;
Temp: Integer;
begin
for i := 0 to High(abc) do
begin
IndexOfMin := i;
for j := i to High(abc) + 1 do
if abc[j] < abc[IndexOfMin] then
IndexOfMin := j;
Temp := abc[i];
abc[i] := abc[IndexOfMin];
abc[IndexOfMin] := Temp;
end;
end;
// 摇动排序
procedure ShakerSort(var abc: array of Integer);
var
i: Integer;
Temp: Integer;
iMin, iMax: Integer;
begin
iMin := 0;
iMax := High(abc) - Low(abc) + 1;
while (iMin < iMax) do
begin
for i := iMax downto 0 do
if abc[i] < abc[i - 1] then
begin
Temp := abc[i];
abc[i] := abc[i - 1];
abc[i - 1] := Temp;
end;
inc(iMin);
for i := 0 to iMax do
if abc[i] < abc[i - 1] then
begin
Temp := abc[i];
abc[i] := abc[i - 1];
abc[i - 1] := Temp;
end;
dec(iMax);
end;
end;
// 希尔排序
procedure ShellSort(var abc: array of Integer);
var
i, j: Integer;
h: Integer;
Temp: Integer;
Ninth: Integer;
begin
h := 1;
Ninth := High(abc) div 9;
while (h <= Ninth) do
h := (h * 3) + 1;
while (h > 0) do
begin
for i := h to High(abc) do
begin
Temp := abc[i];
j := i;
while (j >= (0 + h)) and (Temp < abc[j - h]) do
begin
abc[j] := abc[j - h];
dec(j, h);
end;
abc[j] := Temp;
end;
h := h div 3;
end;
end;
// 标准归并排序
procedure MergeSortStd(var abc: array of Integer);
procedure MSS(var abc: array of Integer; aFirst: Integer; aLast: Integer; aTempList: array of Integer);
var
Mid: Integer;
i, j: Integer;
ToInx: Integer;
FirstCount: Integer;
begin
Mid := (aFirst + aLast) div 2;
if (aFirst < Mid) then
MSS(abc, aFirst, Mid, aTempList);
if (succ(Mid) < aLast) then
MSS(abc, succ(Mid), aLast, aTempList);
FirstCount := succ(Mid - aFirst);
Move(abc[aFirst], aTempList[0], FirstCount * sizeof(pointer));
i := 0;
j := succ(Mid);
ToInx := aFirst;
while (i < FirstCount) and (j <= aLast) do
begin
if (aTempList[i] <= abc[j]) then
begin
abc[ToInx] := aTempList[i];
inc(i);
end
else
begin
abc[ToInx] := abc[j];
inc(j);
end;
inc(ToInx);
end;
if (i < FirstCount) then
Move(aTempList[i], abc[ToInx], (FirstCount - i) * sizeof(pointer));
end;
var
TempList: array of Integer;
begin
if (0 < High(abc)) then
begin
SetLength(TempList, High(abc) div 2);
MSS(abc, 0, High(abc), TempList);
end;
end;
// 优化的归并排序
procedure MergeSort(var abc: array of Integer);
const
MSCutOff = 15;
procedure MSInsertionSort(var abc: array of Integer; aFirst: Integer; aLast: Integer);
var
i, j: Integer;
IndexOfMin: Integer;
Temp: Integer;
begin
IndexOfMin := aFirst;
for i := succ(aFirst) to aLast do
if abc[i] < abc[IndexOfMin] then
IndexOfMin := i;
if (aFirst <> IndexOfMin) then
begin
Temp := abc[aFirst];
abc[aFirst] := abc[IndexOfMin];
abc[IndexOfMin] := Temp;
end;
for i := aFirst + 2 to aLast do
begin
Temp := abc[i];
j := i;
while Temp < abc[j - 1] do
begin
abc[j] := abc[j - 1];
dec(j);
end;
abc[j] := Temp;
end;
end;
procedure MS(var abc: array of Integer; aFirst: Integer; aLast: Integer; aTempList: array of Integer);
var
Mid: Integer;
i, j: Integer;
ToInx: Integer;
FirstCount: Integer;
begin
Mid := (aFirst + aLast) div 2;
if (aFirst < Mid) then
if (Mid - aFirst) <= MSCutOff then
MSInsertionSort(abc, aFirst, Mid)
else
MS(abc, aFirst, Mid, aTempList);
if (succ(Mid) < aLast) then
if (aLast - succ(Mid)) <= MSCutOff then
MSInsertionSort(abc, succ(Mid), aLast)
else
MS(abc, succ(Mid), aLast, aTempList);
FirstCount := succ(Mid - aFirst);
Move(abc[aFirst], aTempList[0], FirstCount * sizeof(pointer));
i := 0;
j := succ(Mid);
ToInx := aFirst;
while (i < FirstCount) and (j <= aLast) do
begin
if (aTempList[i] <= abc[j]) then
begin
abc[ToInx] := aTempList[i];
inc(i);
end
else
begin
abc[ToInx] := abc[j];
inc(j);
end;
inc(ToInx);
end;
if (i < FirstCount) then
Move(aTempList[i], abc[ToInx], (FirstCount - i) * sizeof(pointer));
end;
var
TempList: array of Integer;
begin
if (0 < High(abc)) then
begin
SetLength(TempList, High(abc) div 2);
MS(abc, 0, High(abc), TempList);
end;
end;
// 标准快速排序
procedure QuickSortStd(var abc: array of Integer);
procedure QSS(var abc: array of Integer; aFirst: Integer; aLast: Integer);
var
L, R: Integer;
Pivot: Integer;
Temp: Integer;
begin
while (aFirst < aLast) do
begin
Pivot := abc[(aFirst + aLast) div 2];
L := pred(aFirst);
R := succ(aLast);
while true do
begin
repeat
dec(R);
until (abc[R] <= Pivot);
repeat
inc(L);
until (abc[L] >= Pivot);
if (L >= R) then
Break;
Temp := abc[L];
abc[L] := abc[R];
abc[R] := Temp;
end;
if (aFirst < R) then
QSS(abc, aFirst, R);
aFirst := succ(R);
end;
end;
begin
QSS(abc, 0, High(abc));
end;
// 无递归的快速排序
procedure QuickSortNoRecurse(var abc: array of Integer);
procedure QSNR(var abc: array of Integer; aFirst: Integer; aLast: Integer);
var
L, R: Integer;
Pivot: Integer;
Temp: Integer;
Stack: array [0 .. 63] of Integer; { allows for 2 billion items }
SP: Integer;
begin
Stack[0] := aFirst;
Stack[1] := aLast;
SP := 2;
while (SP <> 0) do
begin
dec(SP, 2);
aFirst := Stack[SP];
aLast := Stack[SP + 1];
while (aFirst < aLast) do
begin
Pivot := abc[(aFirst + aLast) div 2];
L := pred(aFirst);
R := succ(aLast);
while true do
begin
repeat
dec(R);
until (abc[R] <= Pivot);
repeat
inc(L);
until (abc[L] >= Pivot);
if (L >= R) then
Break;
Temp := abc[L];
abc[L] := abc[R];
abc[R] := Temp;
end;
if (R - aFirst) < (aLast - R) then
begin
Stack[SP] := succ(R);
Stack[SP + 1] := aLast;
inc(SP, 2);
aLast := R;
end
else
begin
Stack[SP] := aFirst;
Stack[SP + 1] := R;
inc(SP, 2);
aFirst := succ(R);
end;
end;
end;
end;
begin
QSNR(abc, 0, High(abc));
end;
// 随机的快速排序
procedure QuickSortRandom(var abc: array of Integer);
procedure QSR(var abc: array of Integer; aFirst: Integer; aLast: Integer);
var
L, R: Integer;
Pivot: Integer;
Temp: Integer;
begin
while (aFirst < aLast) do
begin
R := aFirst + Random(aLast - aFirst + 1);
L := (aFirst + aLast) div 2;
Pivot := abc[R];
abc[R] := abc[L];
abc[L] := Pivot;
L := pred(aFirst);
R := succ(aLast);
while true do
begin
repeat
dec(R);
until (abc[R] <= Pivot);
repeat
inc(L);
until (abc[L] >= Pivot);
if (L >= R) then
Break;
Temp := abc[L];
abc[L] := abc[R];
abc[R] := Temp;
end;
if (aFirst < R) then
QSR(abc, aFirst, R);
aFirst := succ(R);
end;
end;
begin
QSR(abc, 0, High(abc));
end;
// 中间值的快速排序
procedure QuickSortMedian(var abc: array of Integer);
procedure QSM(var abc: array of Integer; aFirst: Integer; aLast: Integer);
var
L, R: Integer;
Pivot: Integer;
Temp: Integer;
begin
while (aFirst < aLast) do
begin
if (aLast - aFirst) >= 2 then
begin
R := (aFirst + aLast) div 2;
if (abc[aFirst] > abc[R]) then
begin
Temp := abc[aFirst];
abc[aFirst] := abc[R];
abc[R] := Temp;
end;
if (abc[aFirst] > abc[aLast]) then
begin
Temp := abc[aFirst];
abc[aFirst] := abc[aLast];
abc[aLast] := Temp;
end;
if (abc[R] > abc[aLast]) then
begin
Temp := abc[R];
abc[R] := abc[aLast];
abc[aLast] := Temp;
end;
Pivot := abc[R];
end
else
Pivot := abc[aFirst];
L := pred(aFirst);
R := succ(aLast);
while true do
begin
repeat
dec(R);
until (abc[R] <= Pivot);
repeat
inc(L);
until (abc[L] >= Pivot);
if (L >= R) then
Break;
Temp := abc[L];
abc[L] := abc[R];
abc[R] := Temp;
end;
if (aFirst < R) then
QSM(abc, aFirst, R);
aFirst := succ(R);
end;
end;
begin
QSM(abc, 0, High(abc));
end;
// 优化插入的快速排序
procedure QuickSort(var abc: array of Integer);
const
QSCutOff = 15;
procedure QSInsertionSort(var abc: array of Integer; aFirst: Integer; aLast: Integer);
var
i, j: Integer;
IndexOfMin: Integer;
Temp: Integer;
begin
IndexOfMin := aFirst;
j := aFirst + QSCutOff; { !!.01 }
if (j > aLast) then
j := aLast;
for i := succ(aFirst) to j do
if abc[i] < abc[IndexOfMin] then
IndexOfMin := i;
if (aFirst <> IndexOfMin) then
begin
Temp := abc[aFirst];
abc[aFirst] := abc[IndexOfMin];
abc[IndexOfMin] := Temp;
end;
{ now sort via fast insertion method }
for i := aFirst + 2 to aLast do
begin
Temp := abc[i];
j := i;
while Temp < abc[j - 1] do
begin
abc[j] := abc[j - 1];
dec(j);
end;
abc[j] := Temp;
end;
end;
procedure QS(var abc: array of Integer; aFirst: Integer; aLast: Integer);
var
L, R: Integer;
Pivot: Integer;
Temp: Integer;
Stack: array [0 .. 63] of Integer; { allows for 2 billion items }
SP: Integer;
begin
Stack[0] := aFirst;
Stack[1] := aLast;
SP := 2;
while (SP <> 0) do
begin
dec(SP, 2);
aFirst := Stack[SP];
aLast := Stack[SP + 1];
while ((aLast - aFirst) > QSCutOff) do
begin
R := (aFirst + aLast) div 2;
if (abc[aFirst] > abc[R]) then
begin
Temp := abc[aFirst];
abc[aFirst] := abc[R];
abc[R] := Temp;
end;
if (abc[aFirst] > abc[aLast]) then
begin
Temp := abc[aFirst];
abc[aFirst] := abc[aLast];
abc[aLast] := Temp;
end;
if (abc[R] > abc[aLast]) then
begin
Temp := abc[R];
abc[R] := abc[aLast];
abc[aLast] := Temp;
end;
Pivot := abc[R];
L := aFirst;
R := aLast;
while true do
begin
repeat
dec(R);
until (abc[R] <= Pivot);
repeat
inc(L);
until (abc[L] >= Pivot);
if (L >= R) then
Break;
Temp := abc[L];
abc[L] := abc[R];
abc[R] := Temp;
end;
if (R - aFirst) < (aLast - R) then
begin
Stack[SP] := succ(R);
Stack[SP + 1] := aLast;
inc(SP, 2);
aLast := R;
end
else
begin
Stack[SP] := aFirst;
Stack[SP + 1] := R;
inc(SP, 2);
aFirst := succ(R);
end;
end;
end;
end;
begin
QS(abc, 0, High(abc));
QSInsertionSort(abc, 0, High(abc));
end;
// 堆排序
procedure HeapSort(var abc: array of Integer);
procedure HSTrickleDown(var abc: array of Integer; root, count: Integer);
var
KKK: Integer;
begin
abc[0] := abc[root];
KKK := 2 * root;
while KKK <= count do
begin
if (KKK < count) and (abc[KKK] < abc[KKK + 1]) then
inc(KKK);
if abc[0] < abc[KKK] then
begin
abc[root] := abc[KKK];
root := KKK;
KKK := 2 * root;
end
else
KKK := count + 1;
end;
abc[root] := abc[0];
end;
var
Inx: Integer;
ItemCount: Integer;
tmp: Integer;
begin
ItemCount := High(abc) - Low(abc) + 1;
for Inx := ItemCount div 2 downto 1 do
begin
HSTrickleDown(abc, Inx, ItemCount);
end;
for Inx := ItemCount downto 2 do
begin
tmp := abc[1];
abc[1] := abc[Inx];
abc[Inx] := tmp;
HSTrickleDown(abc, 1, Inx - 1);
end;
end;
end.
//原文链接:https://blog.csdn.net/dbyoung/java/article/details/8086618