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

    UNIT Sort;

      { These sort routines are for arrays of Integers.  Count is the maximum }
      { number of items in the array.                                         }

    {****************************************************************************}
                                 INTERFACE
    {****************************************************************************}
    FUNCTION  BinarySearch (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}
    FUNCTION  SequentialSearch (VAR A; X : Integer; Count : Integer) : Integer;
    PROCEDURE ShellSort (VAR A; Count : Integer);  {moderate}
    {****************************************************************************}
                                 IMPLEMENTATION
    {****************************************************************************}
    TYPE
      SortArray = ARRAY[0..0] OF Integer;
    {****************************************************************************}
    {                                                                            }
    {                   Local Procedures and Functions                           }
    {                                                                            }
    {****************************************************************************}
    PROCEDURE Swap (VAR A, B : Integer);
    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;
    {****************************************************************************}
    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;
    {****************************************************************************}
    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 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.

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