Delphi常用排序

1.冒泡排序

Delphi/Pascal code

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

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.选择排序

Delphi/Pascal code

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

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.插入排序

Delphi/Pascal code

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

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.希尔排序

Delphi/Pascal code

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21

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.快速排序

Delphi/Pascal code

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27

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.归并排序

Delphi/Pascal code

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62

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.堆排序

Delphi/Pascal code

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49

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 ;