排序的各种算法

其他 2020-04-23 19:01:19 阅读次数: 0 
//主要参考：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

猜你喜欢

转载自www.cnblogs.com/fansizhe/p/12762786.html
今日推荐
《美国对全球网络空间安全与发展的威胁和破坏》报告发布
火速冲上 GitHub 热榜 —— 开源编程语言、框架哪有这么可爱？
北京人形机器人创新中心发布全球首个纯电驱拟人奔跑的全尺寸人形机器人“天工”
LFOSSA 源来如此公开课 | 掌握云原生未来：CNCF 认证全面攻略与备考秘籍
周排行
循环神经网络（rnn）讲解
Tigao教程四：单独的关节运动
金蝶K3WISE15.0-注册套打教程
如何在Mac上配置Kubernetes
Android应用结束自身进程的方法
SpringMVC学习 十三 拦截器栈
中国驻洛杉矶总领馆举行新春招待会
HttpClient get post 发送
11 - three.js 笔记 - 绘制三维字体模型
Mysql递归获取某个父节点下面的所有子节点和子节点上的所有父节点
每日归档
更多
2024-05-01(4)
2024-04-30(1)
2024-04-29(40)
2024-04-28(0)
2024-04-27(56)
2024-04-26(39)
2024-04-25(22)
2024-04-24(36)
2024-04-23(26)
2024-04-22(39)

代码天地 © 2018 codetd.com

境外服务器   最新电视剧2022