zoukankan      html  css  js  c++  java
  • Implementing Sort Algorithm in Delphi

    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.

  • 相关阅读:
    Docker下安装redis
    Goodnotes5
    Notability
    浏览器好用的技术
    苹果平板上好用的软件推荐
    苹果平板爱思助手检验安兔兔
    积分超过排名的第一天
    卸载Windows控制面板的程序和功能中找不到的一些软件的方法
    怎样在GitHub上新建一个文件夹
    Vim的常用操作
  • 原文地址:https://www.cnblogs.com/shangdawei/p/3050180.html
Copyright © 2011-2022 走看看