[Back to SORTING SWAG index]  [Back to Main SWAG index]  [Original]

{
> Could someone please post some code on using a quick
> sort to sort an array of strings?

   I can do even better than that. I can give you some code on a general qsort
routine that works like in C (if you're familiar with that). I. e. you can sort
any type of arrays, if only you supply the correct compare function. Here
goes...
}

unit QSort;
{*********************************************************
 *                     QSORT.PAS                         *
 *           C-like QuickSort implementation             *
 *     Written 931118 by Bj�rn Felten @ 2:203/208        *
 *           After an idea by Pontus Rydin               *
 *********************************************************}
interface
type CompFunc = function(Item1, Item2 : word) : integer;

procedure QuickSort(
    var Data;
{An array. Must be [0..Count-1] and not [1..Count] or anything else! }
    Count,
{Number of elements in the array}
    Size    : word;
{Size in bytes of a single element -- e.g. 2 for integers or words,
4 for longints, 256 for strings and so on }
    Compare : CompFunc);
{The function that decides which element is "greater" or "less". Must
return an integer that's < 0 if the first element is less, 0 if they're
equal and > 0 if the first element is greater. A simple Compare for
words can look like this:

 function WordCompare(Item1, Item2: word): integer;
 begin
     WordCompare := MyArray[Item1] - MyArray[Item2]
 end;

NB. It's not the =indices= that shall be compared, it's the elements that
the supplied indices points to! Very important to remember!
Also note that the array may be sorted in descending order just by
means of a simple swap of Item1 and Item2 in the example.}

implementation
procedure QuickSort;

  procedure Swap(Item1, Item2 : word);
  var  P1, P2 : ^byte; I : word;
  begin
     if Item1 <> Item2 then
     begin
          I  := Size;
          P1 := @Data; inc(P1, Item1 * Size);
          P2 := @Data; inc(P2, Item2 * Size);
          asm
            mov  cx,I      { Size }
            les  di,P1
            push ds
            lds  si,P2
          @L:
            mov  ah,es:[di]
            lodsb
            mov  [si-1],ah
            stosb
            loop @L
            pop  ds
          end
      end
  end;

  procedure Sort(Left, Right: integer);
  var  i, j, x, y : integer;
  begin
     i := Left; j := Right; x := (Left+Right) div 2;
     repeat
        while compare(i, x) < 0 do inc(i);
        while compare(x, j) < 0 do dec(j);
        if i <= j then
        begin
           swap(i, j); inc(i); dec(j)
        end
     until i > j;
     if Left < j then Sort(Left, j);
     if i < Right then Sort(i, Right)
  end;

begin Sort(0, Count) end;

end. { of unit }

{ A simple testprogram can look like this: }

program QS_Test; {Test QuickSort � la C}
uses qsort;
var v: array[0..9999] of word;
    i: word;

{$F+} {Must be compiled as FAR calls!}
function cmpr(a, b: word): integer;
begin cmpr := v[a] - v[b] end;

function cmpr2(a, b: word): integer;
begin cmpr2 := v[b] - v[a] end;
{$F-}

begin
 randomize;
 for i := 0 to 9999 do v[i] := random(20000);
 quicksort(v, 10000, 2, cmpr);  {in order lo to hi}
 quicksort(v, 10000, 2, cmpr2); {we now have a sorted list, sort it in
                                {reverse -- nasty for qsort!}
 quicksort(v, 10000, 2, cmpr);  {and reverse again}
 quicksort(v, 10000, 2, cmpr);  {sort a sorted list -- also not very popular}
end.

[Back to SORTING SWAG index]  [Back to Main SWAG index]  [Original]