delphi实现常用的几种排序算法

程晨c 2014-09-02 05:49:47

加精

1.冒泡排序



procedure BubbleSort(var x:array of integer);

var

  i,j,intTmp:integer;

begin

  for i:=0 to high(x) do

  begin

    for j:=0 to high(x)-1 do

    begin

      if x[j]>x[j+1] then

      begin

        intTmp:=x[j];

        x[j]:=x[j+1];

        x[j+1]:=intTmp;

      end;

    end;

  end;

end;

2.选择排序



procedure SelectSort(var x:array of integer);

var

  i,j,k,intTmp:integer;

begin

  for i:=0 to high(x)-1 do

  begin

    intTmp:=x[i];

    k:=i;

    for j:=i+1 to high(x) do

    begin

      if intTmp>x[j] then

      begin

        k:=j;

        intTmp:=x[k];

      end;

    end;

    if k<>i then

    begin

      x[k]:=x[i];

      x[i]:=intTmp;

    end;

  end;

end;

3.插入排序



procedure InsertSort(var x:array of integer);

var

  i,j,intTmp:integer;

begin

  for i:=1 to high(x) do

  begin

    for j:=i downto 1 do

    begin

      if x[j-1]>x[j] then

      begin

        intTmp:=x[j-1];

        x[j-1]:=x[j];

        x[j]:=intTmp;

      end;

    end;

  end;

end;

4.希尔排序



procedure ShellSort(var x:array of integer);

var

  h,i,j,intTmp:integer;

begin

  h:=high(x) div 2;

  while h>0 do

  begin

    for i:=h to high(x) do

    begin

      j:=i;

      while (j>=h) and (x[j-h]>x[j]) do

      begin

        intTmp:=x[j-h];

        x[j-h]:=x[j];

        x[j]:=intTmp;

        j:=j-h;

      end;

    end;

    h:=h div 2;

  end;

end;

5.快速排序



procedure QuickSort(var x:array of integer; L,R:integer);

var

  i,j,intTmp:integer;

begin

  if L<R then

  begin

    i:=L;

    j:=R;

    intTmp:=x[i];

    while i<j do

    begin

      while (i<j) and (x[j]>=intTmp) do

      begin

        j:=j-1;

      end;

      if i<j then x[i]:=x[j];

      while (i<j) and (x[i]<=intTmp) do

      begin

        i:=i+1;

      end;

      if i<j then x[j]:=x[i];

    end;

    x[i]:=intTmp;

    QuickSort(x,L,i-1);

    QuickSort(x,i+1,R);

  end;

end;

6.归并排序



procedure Merge(var x,y:array of integer; L,M,R:integer);

var

  i,j:integer;

begin

  i:=L;

  j:=M+1;

  while (L<=M) and (j<=R) do

  begin

    if x[L]> x[j] then

    begin

      y[i]:=x[j];

      j:=j+1;

    end

    else

    begin

      y[i]:=x[L];

      L:=L+1;

    end;

    i:=i+1;

  end;

  while L<=M do

  begin

    y[i]:=x[L];

    i:=i+1;

    L:=L+1;

  end;

  while j<=R do

  begin

    y[i]:=x[j];

    i:=i+1;

    j:=j+1;

  end;

end;



procedure MergeSort(var x, y:TArrInt);

var

  intLength,intLen,intLen_m,i:integer;

  tmp:TArrInt;

begin

  intLength:=high(x)+1;

  intLen:=1;



  while intLen<intLength do

  begin

    intLen_m:=intLen;

    intLen:=intLen*2;

    i:=0;

    while i+intLen<intLength do

    begin

      Merge(x,y,i,i+intLen_m-1,i+intLen-1);

      i:=i+intLen;

    end;

    if i+intLen_m<intLength then

    begin

      Merge(x,y,i,i+intLen_m-1,intLength-1);

    end;



    tmp:=x;

    x:=y;

    y:=tmp;

  end;

end;

7.堆排序



procedure HeapAdjust(var x:array of integer; i,intLen:integer);

var

  intTmp,intChild:integer;

begin

  intTmp:=x[i];

  intChild:=2*i+1;

  while intChild<intLen do

  begin

    if (intChild+1<intLen) and (x[intChild]<x[intChild+1]) then

    begin

      intChild:=intChild+1;

    end;

    if x[i]<x[intChild] then

    begin

      x[i]:=x[intChild];

      i:=intChild;

      intChild:=2*i+1;

    end

    else

    begin

      break;

    end;

    x[i]:=intTmp;

  end;

end;



procedure BuildHeap(var x:array of integer);

var

  i:integer;

begin

  for i:=high(x) div 2 downto 0 do

  begin

    HeapAdjust(x,i,High(x)+1);

  end;

end;



procedure HeapSort(var x:array of integer);

var

  i,intTmp:integer;

begin

  BuildHeap(x);

  for i:=high(x) downto 0 do

  begin

    intTmp:=x[i];

    x[i]:=x[0];

    x[0]:=intTmp;

    HeapAdjust(x,0,i);

  end;

end;

...全文

10849 60 打赏收藏转发到动态举报

写回复

用AI写文章

60 条回复

切换为时间正序

请发表友善的回复…

发表回复

sczyq 2016-04-29

打赏
举报

楼主帮忙看看, 这是自己做的, 也不知是什么排序法, 关键是速度快不快


procedure ListSorting(AList : TList<Pointer>);
  
  // _Compare 只是一个模型, 实际应用中, 改成复杂的数据次序
 function _Compare(A, B : Integer) : Boolean;
 begin                              
   Result := PInteger(AList[A]) > PInteger(AList[B]);  // 前后次序是颠倒的
 end;
  
var
  I, N, M, L : Integer;                  // Index, New, Middle, Low
  
begin
  for I = 1 to AList.Count - 1 do        // 必须大于 1 条记录
  if _Compare(I-1, I) then　　           // 首先与上条记录比较, 如果次序正确就很幸运
  begin
    N := I - 1;                          // New 是已经比过了, 比 Index 大
    L := 0;　　　　　　　　　　　　　　　// 比较 0 到 Index-1 ;  Index-1 是指已经排好序的记录
    while N > L do                       // 一直做到这样 
    begin
      M := (N + L) div 2;                // 得到中间数, 只有 Low = New - 1, 那么 Mid = Low;
      if _Compare(M, I) then　           // 比较已经排序好的中间数, 可以减少次数
        N := M                           // 中间数比 Index 大, 就是 New
      else L := M + 1;                   // 中间数比 Index 小或相等的, 就是 Low 
    end;
    AList.Move(I, N);                    // 将 Index 移到 New , 实际是插入
  end;
end;

yyd9015 2015-12-30

打赏
举报

支持，有用，谢谢了

caonumber 2014-09-13

打赏
举报

此贴还是很有学习价值的。

lxdddxl 2014-09-13

打赏
举报

这里有个有趣的帖子,关于各种排序的竞赛 http://bbs.csdn.net/topics/240026102 可惜有漏洞被人钻了空子,如果是字符串或浮点数排序才能比较出不同排序算法的优劣

csdncc2 2014-09-12

打赏
举报

csdncc2 2014-09-12

打赏
举报

重新注册了个账号上来

引用 52 楼 sz_haitao 的回复:

[quote=引用 50 楼 lxdddxl 的回复:]
楼主的快速排序代码不对,这是Delphi自带的快速排序,速度遥遥领先其他所有算法,
而且即使1千万个数据也没有栈溢出

type

	TIntArray=array of integer;



procedure QuickSort0(var A: TIntArray; iLo, iHi: Integer);

  var

	 Lo, Hi, Mid, T: Integer;

  begin

	 Lo := iLo;

	 Hi := iHi;

	 Mid := A[(Lo + Hi) div 2];

	 repeat

		while A[Lo] < Mid do Inc(Lo);

		while A[Hi] > Mid do Dec(Hi);

		if Lo <= Hi then

		begin

		  T := A[Lo];

		  A[Lo] := A[Hi];

		  A[Hi] := T;

		  Inc(Lo);

		  Dec(Hi);

		end;

	 until Lo > Hi;

	 if Hi > iLo then QuickSort0(A, iLo, Hi);

	 if Lo < iHi then QuickSort0(A, Lo, iHi);

  end;



procedure QuickSort(var x:TIntArray);

begin

QuickSort0(x,Low(x),High(x));

end;

这个算法与我在33楼贴的思路相同，的确不会堆栈溢出，也不会因为数据已排序而变慢[/quote]

确实快了很多

算法是一致的
只是用repeat代替了外层的while循环
用inc代替了i:=i+1
用dec代替了j:=j-1

以下是测试结果

csdncc2 2014-09-12

打赏
举报

账号被管理员封了因为有个帖子发帖的IP跟我回复的IP一致估计是公司其它员工同一路由器上外网所致问了同事们也没人承认

haitao 2014-09-10

打赏
举报

引用 50 楼 lxdddxl 的回复:

楼主的快速排序代码不对,这是Delphi自带的快速排序,速度遥遥领先其他所有算法, 而且即使1千万个数据也没有栈溢出

type
	TIntArray=array of integer;

procedure QuickSort0(var A: TIntArray; iLo, iHi: Integer);
  var
	 Lo, Hi, Mid, T: Integer;
  begin
	 Lo := iLo;
	 Hi := iHi;
	 Mid := A[(Lo + Hi) div 2];
	 repeat
		while A[Lo] < Mid do Inc(Lo);
		while A[Hi] > Mid do Dec(Hi);
		if Lo <= Hi then
		begin
		  T := A[Lo];
		  A[Lo] := A[Hi];
		  A[Hi] := T;
		  Inc(Lo);
		  Dec(Hi);
		end;
	 until Lo > Hi;
	 if Hi > iLo then QuickSort0(A, iLo, Hi);
	 if Lo < iHi then QuickSort0(A, Lo, iHi);
  end;

procedure QuickSort(var x:TIntArray);
begin
QuickSort0(x,Low(x),High(x));
end;

这个算法与我在33楼贴的思路相同，的确不会堆栈溢出，也不会因为数据已排序而变慢

twtiqfn 2014-09-10

打赏
举报

算法是最难的，听着就头大了啊

lxdddxl 2014-09-10

打赏
举报

楼主的快速排序代码不对,这是Delphi自带的快速排序,速度遥遥领先其他所有算法, 而且即使1千万个数据也没有栈溢出

type
	TIntArray=array of integer;

procedure QuickSort0(var A: TIntArray; iLo, iHi: Integer);
  var
	 Lo, Hi, Mid, T: Integer;
  begin
	 Lo := iLo;
	 Hi := iHi;
	 Mid := A[(Lo + Hi) div 2];
	 repeat
		while A[Lo] < Mid do Inc(Lo);
		while A[Hi] > Mid do Dec(Hi);
		if Lo <= Hi then
		begin
		  T := A[Lo];
		  A[Lo] := A[Hi];
		  A[Hi] := T;
		  Inc(Lo);
		  Dec(Hi);
		end;
	 until Lo > Hi;
	 if Hi > iLo then QuickSort0(A, iLo, Hi);
	 if Lo < iHi then QuickSort0(A, Lo, iHi);
  end;

procedure QuickSort(var x:TIntArray);
begin
QuickSort0(x,Low(x),High(x));
end;