• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

ImplementingSortAlgorithminDelphi

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

QuickSort Algorith

One of the common problems in programming is to sort an array of values in some order (ascending or descending).

While there are many "standard" sorting algorithms, QuickSort is one of the fastest.

Quicksort sorts by employing a divide and conquer strategy to divide a list into two sub-lists.

The basic concept is to pick one of the elements in the array, called a pivot.

Around the pivot, other elements will be rearranged.

Everything less than the pivot is moved left of the pivot - into the left partition.

Everything greater than the pivot goes into the right partition.

At this point each partition is recursively "quick sorted".

Here's QuickSort algorithm implemented in Delphi:

procedure QuickSort( var A: array of integer; iLo, iHi: integer );
var
  Lo, Hi, Pivot, T: integer;
begin
  Lo := iLo;
  Hi := iHi;
  Pivot := A[ ( Lo + Hi ) div 2 ];
  repeat
    while A[ Lo ] < Pivot do
      Inc( Lo );
    while A[ Hi ] > Pivot 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 QuickSort( A, iLo, Hi );
if Lo < iHi then QuickSort( A, Lo, iHi ); end;

Usage :

var
  intArray : array of integer;
begin
  SetLength(intArray,10) ;
 
  //Add values to intArray
  intArray[0] := 2007;
  ...
  intArray[9] := 1973;
 
  //sort
  QuickSort( intArray, Low( intArray ), High( intArray ) ) ;
end;

Note: in practice, the QuickSort becomes very slow when the array passed to it is already close to being sorted.

Note: There's a demo program that ships with Delphi, called "thrddemo" in the "Threads" folder

which shows additional two sorting alorithms: Bubble sort and Selection Sort

BubbleSort Algorith

procedure BubbleSort( var Vetor: Array of integer );
var
  i, temp: integer;
  changed: Boolean;
begin
  changed := True;

  while changed do
  begin
    changed := False;
    for i := Low( Vetor ) to High( Vetor ) - 1 do
    begin
      if ( Vetor[ i ] > Vetor[ i + 1 ] ) then
      begin
        temp := Vetor[ i + 1 ];
        Vetor[ i + 1 ] := Vetor[ i ];
        Vetor[ i ] := temp;
        changed := True;
      end;
    end;
  end;
end;

Usage :

var
  intArray : array of integer;
begin
  SetLength(intArray,10) ;
 
  //Add values to intArray
  intArray[0] := 2007;
  ...
  intArray[9] := 1973;
 
  //sort
  BubbleSort( intArray ) ;
end;

 

Selection Sort Algorith

 

procedure SelectionSort( var A: Array of integer );
var
  X, i, J, M: integer;
begin
  for i := Low( A ) to High( A ) - 1 do
  begin
    M := i;
    for J := i + 1 to High( A ) do
      if A[ J ] < A[ M ] then
        M := J;
    X := A[ M ];
    A[ M ] := A[ i ];
    A[ i ] := X;
  end;
end;

Usage :

var
  intArray : array of integer;
begin
  SetLength(intArray,10) ;
 
  //Add values to intArray
  intArray[0] := 2007;
  ...
  intArray[9] := 1973;
 
  //sort
  SectionSort( intArray ) ;
end;
unit uSort;

{ These sort routines are for arrays of Integers.
  Count is the maximum number of items in the array. }

INTERFACE

type
  Sortarray = array [ 0 .. 0 ] OF Word;

function BinarySearch( var A; X : Integer; Count : Integer ) : Integer;
function SequentialSearch( var A; X : Integer; Count : Integer ) : Integer;

procedure BubbleSort( var A; Count : Integer ); { slow }
procedure CombSort( var A; Count : Integer );
procedure QuickSort( var A; Count : Integer ); { fast }
procedure ShellSort( var A; Count : Integer ); { moderate }

IMPLEMENTATION

{ Local procedures and functions }
procedure Swap( var A, B : Word );
var
  C : Integer;
begin
  C := A;
  A := B;
  B := C;
end;

{ Global procedures and functions }
function BinarySearch( var A; X : Integer; Count : Integer ) : Integer;
var
  High, Low, Mid : Integer;
begin
  Low := 1;
  High := Count;
  while High >= Low do
  begin
    Mid := Trunc( High + Low ) DIV 2;
    if X > Sortarray( A )[ Mid ] then
      Low := Mid + 1
    else if X < Sortarray( A )[ Mid ] then
      High := Mid - 1
    else
      High := -1;
  end;
  if High = -1 then
    BinarySearch := Mid
  else
    BinarySearch := 0;
end;

function SequentialSearch( var A; X : Integer; Count : Integer ) : Integer;
var
  i : Integer;
begin
  for i := 1 to Count do
    if X = Sortarray( A )[ i ] then
    begin
      SequentialSearch := i;
      Exit;
    end;
  SequentialSearch := 0;
end;

procedure BubbleSort( var A; Count : Integer );
var
  i, j : Integer;
begin
  for i := 2 to Count do
    for j := Count downto i do
      if Sortarray( A )[ j - 1 ] > Sortarray( A )[ j ] then
        Swap( Sortarray( A )[ j ], Sortarray( A )[ j - 1 ] );
end;

procedure CombSort( var A; Count : Integer );
{ The combsort is an optimised version of the bubble sort. It uses a }
{ decreasing gap in order to compare values of more than one element }
{ apart.  By decreasing the gap the array is gradually "combed" into }
{ order ... like combing your hair. First you get rid of the large }
{ tangles, then the smaller ones ... }
{ There are a few particular things about the combsort. }
{ Firstly, the optimal shrink factor is 1.3 (worked out through a }
{ process of exhaustion by the guys at BYTE magazine). Secondly, by }
{ never having a gap of 9 or 10, but always using 11, the sort is }
{ faster. }
{ This sort approximates an n log n sort - it's faster than any other }
{ sort I've seen except the quicksort (and it beats that too sometimes). }
{ The combsort does not slow down under *any* circumstances. In fact, on }
{ partially sorted lists (including *reverse* sorted lists) it speeds up. }
CONST
  ShrinkFactor = 1.3; { Optimal shrink factor ... }
var
  Gap, i, Temp : Integer;
  Finished : Boolean;
begin
  Gap := Trunc( ShrinkFactor );
  REPEAT
    Finished := TRUE;
    Gap := Trunc( Gap / ShrinkFactor );
    if Gap < 1 then { Gap must *never* be less than 1 }
      Gap := 1
    else if Gap IN [ 9, 10 ] then { Optimises the sort ... }
      Gap := 11;
    for i := 1 to ( Count - Gap ) do
      if Sortarray( A )[ i ] < Sortarray( A )[ i + Gap ] then
      begin
        Swap( Sortarray( A )[ i ], Sortarray( A )[ i + Gap ] );
        Finished := FALSE;
      end;
  UNTIL ( Gap = 1 ) AND Finished;
end;

procedure QuickSort( var A; Count : Integer );

  procedure PartialSort( LowerBoundary, UpperBoundary : Integer; var A );
  var
    ii, l1, r1, i, j, k : Integer;
  begin
    k := ( Sortarray( A )[ LowerBoundary ] + Sortarray( A )
      [ UpperBoundary ] ) DIV 2;
    i := LowerBoundary;
    j := UpperBoundary;
    REPEAT
      while Sortarray( A )[ i ] < k do
        Inc( i );
      while k < Sortarray( A )[ j ] do
        Dec( j );
      if i <= j then
      begin
        Swap( Sortarray( A )[ i ], Sortarray( A )[ j ] );
        Inc( i );
        Dec( j );
      end;
    UNTIL i > j;
    if LowerBoundary < j then
      PartialSort( LowerBoundary, j, A );
    if i < UpperBoundary then
      PartialSort( UpperBoundary, i, A );
  end;

begin
  PartialSort( 1, Count, A );
end;

procedure ShellSort( var A; Count : Integer );
var
  Gap, i, j, k : Integer;
begin
  Gap := Count DIV 2;
  while ( Gap > 0 ) do
  begin
    for i := ( Gap + 1 ) to Count do
    begin
      j := i - Gap;
      while ( j > 0 ) do
      begin
        k := j + Gap;
        if ( Sortarray( A )[ j ] <= Sortarray( A )[ k ] ) then
          j := 0
        else
          Swap( Sortarray( A )[ j ], Sortarray( A )[ k ] );
        j := j - Gap;
      end;
    end;
    Gap := Gap DIV 2;
  end;
end;

end.

 


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
Ubuntu Matlab R2017a 破解安装发布时间:2022-07-18
下一篇:
Delphi中关于MOVE和CopyMemory的用法区别发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap