排序算法总结

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.