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.