home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 061-070 / amok62 / sorting / sorting.mod < prev    next >
Encoding:
Modula Implementation  |  1993-11-04  |  3.2 KB  |  101 lines
  1. (******************************************************************************
  2.  
  3.     :Program.    Sorting.mod
  4.     :Contents.   procedure for sorting
  5.     :Author.     Markus Uhlendahl
  6.     :Address.    Vorm Burgtor 16, D-4408 Dülmen
  7.     :Phone.      02594/81540
  8.     :Language.   Modula-2
  9.     :Translator. M2Amiga 4.0d
  10.     :Copyright.  Public Domain
  11.     :History.    15.11.91 --- 1.0 --- first release
  12.  
  13. ******************************************************************************)
  14. IMPLEMENTATION MODULE Sorting;
  15.  
  16.  
  17. PROCEDURE InternalLower (a,b       : LONGINT;
  18.                          Lower     : Comparison;
  19.                          ascending : BOOLEAN) : BOOLEAN;
  20. (*
  21.  * FUNCTION     compare two elements
  22.  *              If ascending is TRUE it returns element a lower than element b
  23.  *              else it returns element a greater than element b
  24.  * INPUTS       a = index of an element in the array
  25.  *              b = index of an element in the array
  26.  *              Lower = PROCEDURE which compares two elements of an array
  27.  *                      returns TRUE if the first element of the comparison
  28.  *                      is really lower (a<b) than the second element
  29.  *              ascending = if ascending is TRUE the result will be a<b else
  30.  *                          the result will be b<a
  31.  * RESULTS      if ascending than a<b else b<a
  32.  *
  33.  *)
  34.  
  35. BEGIN
  36.   IF ascending THEN
  37.     RETURN (Lower(a,b));
  38.   ELSE
  39.     RETURN (Lower(b,a));
  40.   END;
  41. END InternalLower;
  42.  
  43.  
  44. PROCEDURE QuickSort (first,last : LONGINT;
  45.                      Lower      : Comparison;
  46.                      Swap       : SwapProcedure;
  47.                      ascending  : BOOLEAN);
  48. (*
  49.  * FUNCTION     sort an array
  50.  *              This implementation of the quicksort-algorythm is very
  51.  *              flexible. It sorts arrays of every type and the user can
  52.  *              choose if the array is sorted ascending or not. To make this
  53.  *              possible the user has to write two procedures. One that
  54.  *              compares two elements of the array and one that swaps two
  55.  *              elements.
  56.  * INPUTS       first = first index of the array
  57.  *              last = last index of the array
  58.  *              Lower = PROCEDURE which compares two elements of the array
  59.  *                      returns TRUE if the first element of the comparison
  60.  *                      is really lower (a<b) than the second element
  61.  *              Swap = PROCEDURE which swaps two elements of the array
  62.  *              ascending = if ascending is TRUE the first element of the
  63.  *                          array will be the smallest and the last element
  64.  *                          the greatest
  65.  *                          if ascending is FALSE it will be vice versa
  66.  * BUGS         none known
  67.  * AUTHOR       Markus Uhlendahl
  68.  *
  69.  *)
  70.  
  71. VAR
  72.   i,j,x : LONGINT;
  73.  
  74. BEGIN
  75.   i:=first;
  76.   j:=last;
  77.   x:=(first+last) DIV 2;
  78.   REPEAT
  79.     WHILE InternalLower(i,x,Lower,ascending) DO
  80.       INC (i);
  81.     END;
  82.     WHILE InternalLower(x,j,Lower,ascending) DO
  83.       DEC (j);
  84.     END;
  85.     IF i<=j THEN
  86.       Swap (i,j);
  87.       INC (i);
  88.       DEC (j);
  89.     END;
  90.   UNTIL i>j;
  91.   IF first<j THEN
  92.     QuickSort (first,j,Lower,Swap,ascending);
  93.   END;
  94.   IF i<last THEN
  95.     QuickSort (i,last,Lower,Swap,ascending);
  96.   END;
  97. END QuickSort;
  98.  
  99.  
  100. END Sorting.
  101.