home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / sorting.swg / 0046_Generic QSort.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-27  |  3.5 KB  |  117 lines
  1. {
  2. > Could someone please post some code on using a quick
  3. > sort to sort an array of strings?
  4.  
  5.    I can do even better than that. I can give you some code on a general qsort
  6. routine that works like in C (if you're familiar with that). I. e. you can sort
  7. any type of arrays, if only you supply the correct compare function. Here
  8. goes...
  9. }
  10.  
  11. unit QSort;
  12. {*********************************************************
  13.  *                     QSORT.PAS                         *
  14.  *           C-like QuickSort implementation             *
  15.  *     Written 931118 by Björn Felten @ 2:203/208        *
  16.  *           After an idea by Pontus Rydin               *
  17.  *********************************************************}
  18. interface
  19. type CompFunc = function(Item1, Item2 : word) : integer;
  20.  
  21. procedure QuickSort(
  22.     var Data;
  23. {An array. Must be [0..Count-1] and not [1..Count] or anything else! }
  24.     Count,
  25. {Number of elements in the array}
  26.     Size    : word;
  27. {Size in bytes of a single element -- e.g. 2 for integers or words,
  28. 4 for longints, 256 for strings and so on }
  29.     Compare : CompFunc);
  30. {The function that decides which element is "greater" or "less". Must
  31. return an integer that's < 0 if the first element is less, 0 if they're
  32. equal and > 0 if the first element is greater. A simple Compare for
  33. words can look like this:
  34.  
  35.  function WordCompare(Item1, Item2: word): integer;
  36.  begin
  37.      WordCompare := MyArray[Item1] - MyArray[Item2]
  38.  end;
  39.  
  40. NB. It's not the =indices= that shall be compared, it's the elements that
  41. the supplied indices points to! Very important to remember!
  42. Also note that the array may be sorted in descending order just by
  43. means of a simple swap of Item1 and Item2 in the example.}
  44.  
  45. implementation
  46. procedure QuickSort;
  47.  
  48.   procedure Swap(Item1, Item2 : word);
  49.   var  P1, P2 : ^byte; I : word;
  50.   begin
  51.      if Item1 <> Item2 then
  52.      begin
  53.           I  := Size;
  54.           P1 := @Data; inc(P1, Item1 * Size);
  55.           P2 := @Data; inc(P2, Item2 * Size);
  56.           asm
  57.             mov  cx,I      { Size }
  58.             les  di,P1
  59.             push ds
  60.             lds  si,P2
  61.           @L:
  62.             mov  ah,es:[di]
  63.             lodsb
  64.             mov  [si-1],ah
  65.             stosb
  66.             loop @L
  67.             pop  ds
  68.           end
  69.       end
  70.   end;
  71.  
  72.   procedure Sort(Left, Right: integer);
  73.   var  i, j, x, y : integer;
  74.   begin
  75.      i := Left; j := Right; x := (Left+Right) div 2;
  76.      repeat
  77.         while compare(i, x) < 0 do inc(i);
  78.         while compare(x, j) < 0 do dec(j);
  79.         if i <= j then
  80.         begin
  81.            swap(i, j); inc(i); dec(j)
  82.         end
  83.      until i > j;
  84.      if Left < j then Sort(Left, j);
  85.      if i < Right then Sort(i, Right)
  86.   end;
  87.  
  88. begin Sort(0, Count) end;
  89.  
  90. end. { of unit }
  91.  
  92. { A simple testprogram can look like this: }
  93.  
  94. program QS_Test; {Test QuickSort á la C}
  95. uses qsort;
  96. var v: array[0..9999] of word;
  97.     i: word;
  98.  
  99. {$F+} {Must be compiled as FAR calls!}
  100. function cmpr(a, b: word): integer;
  101. begin cmpr := v[a] - v[b] end;
  102.  
  103. function cmpr2(a, b: word): integer;
  104. begin cmpr2 := v[b] - v[a] end;
  105. {$F-}
  106.  
  107. begin
  108.  randomize;
  109.  for i := 0 to 9999 do v[i] := random(20000);
  110.  quicksort(v, 10000, 2, cmpr);  {in order lo to hi}
  111.  quicksort(v, 10000, 2, cmpr2); {we now have a sorted list, sort it in
  112.                                 {reverse -- nasty for qsort!}
  113.  quicksort(v, 10000, 2, cmpr);  {and reverse again}
  114.  quicksort(v, 10000, 2, cmpr);  {sort a sorted list -- also not very popular}
  115. end.
  116.  
  117.