Implementing Sort Algorithm in Delphi-白红宇

Implementing Sort Algorithm in Delphi

阅读量：5954 次

发布时间：2019-06-19

本文共 7312 字，大约阅读时间需要 24 分钟。

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. }INTERFACEtype  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.