Turbo Toolbox/Turbo_Toolbox.iso/1987/10/sort_mod/sorting.imp

Modula Implementation | 1987-04-14 | 6.2 KB | 253 lines

IMPLEMENTATION MODULE Sorting;


  PROCEDURE Swap (VAR a,b : SortType);       (* vertauscht zwei Elemente a,b *)

    VAR temp : SortType;

    BEGIN
      temp := b;
      b    := a;
      a    := temp;
    END Swap;


(* ------------  Sortieren nach dem Bubble-Sort-Verfahren  ----------------- *)

  PROCEDURE BubbleSort (VAR SortArray  : ARRAY OF SortType;
                            first,last : CARDINAL;
                            Lower      : Comparison;
                            Ascending  : BOOLEAN);

    VAR i,top   : CARDINAL;
        swapped : BOOLEAN;


  (* spezielle Vergleichsfunktion, Berücksichtigung von "Ascending" *)

    PROCEDURE lower (VAR a,b : SortType) : BOOLEAN;

      BEGIN
        IF Ascending THEN
          RETURN Lower(a,b);
        ELSE
          RETURN Lower(b,a);
        END;
      END lower;


 (* der Bubble-Sort-Algorithmus *)

   BEGIN
      top := last;
      REPEAT
        swapped := FALSE;
        FOR i := first TO top-1 DO
          IF lower (SortArray[i+1],SortArray[i]) THEN
            Swap (SortArray[i],SortArray[i+1]);
            swapped := TRUE;
          END;
        END;
        DEC (top);
      UNTIL NOT swapped;
    END BubbleSort;



(* -------------  Sortieren nach dem Shell-Sort-Verfahren  ----------------- *)

  PROCEDURE ShellSort (VAR SortArray  : ARRAY OF SortType;
                           first,last : CARDINAL;
                           Lower      : Comparison;
                           Ascending  : BOOLEAN);

    VAR i,j,p : CARDINAL;


  (* spezielle Vergleichsfunktion, Berücksichtigung von "Ascending" *)

    PROCEDURE lower (VAR a,b : SortType) : BOOLEAN;

      BEGIN
        IF Ascending THEN
          RETURN Lower(a,b);
        ELSE
          RETURN Lower(b,a);
        END;
      END lower;


  (* der verfeinerte Shell-Sort-Algorithmus *)

    BEGIN
      p := last - first + 1;
      WHILE p > 1 DO
        p := p DIV 2;
        FOR i:=first TO last-p DO
          IF lower(SortArray[i+p],SortArray[i]) THEN
            Swap (SortArray[i],SortArray[i+p]);
            j := i;
            WHILE (j >= first+p) AND lower(SortArray[j],SortArray[j-p]) DO
              Swap (SortArray[j],SortArray[j-p]);
              j := j - p;
            END;
          END;
        END;
      END;
    END ShellSort;



(* -------------  Sortieren nach dem Quick-Sort-Verfahren  ----------------- *)

  PROCEDURE QuickSort (VAR SortArray  : ARRAY OF SortType;
                           first,last : CARDINAL;
                           Lower      : Comparison;
                           Ascending  : BOOLEAN);


  (* spezielle Vergleichsfunktion, Berücksichtigung von "Ascending" *)

    PROCEDURE lower (VAR a,b : SortType) : BOOLEAN;

      BEGIN
        IF Ascending THEN
          RETURN Lower(a,b);
        ELSE
          RETURN Lower(b,a);
        END;
      END lower;


  (* Suche nach zwei Elementen mit unterschiedlichen Schlüsseln (a # b) *)

    PROCEDURE FindPivot(l,r : CARDINAL) : CARDINAL;

      VAR First : SortType;
          Count : CARDINAL;

      BEGIN
        First := SortArray[l];
        FOR Count := l+1 TO r DO
          IF lower(SortArray[Count],First) THEN
            RETURN l;
          ELSE
            IF lower(First,SortArray[Count]) THEN
              RETURN Count;
            END;
          END;
        END;
        RETURN 0;
      END FindPivot;


  (* Ordnen des Teilintervalls l..r, in zwei Intervalle l..p, p+1..r *)

    PROCEDURE Permute(l,r : CARDINAL; Pivot : SortType) : CARDINAL;

      VAR i,j : CARDINAL;

      BEGIN
        i := l;
        j := r;
        REPEAT
          Swap (SortArray[i],SortArray[j]);
          WHILE lower(SortArray[i],Pivot) DO
            INC (i);
          END;
          WHILE NOT lower(SortArray[j],Pivot) DO
            DEC (j);
          END;
        UNTIL (i > j);
        RETURN i;
      END Permute;


   (* Das Kernstück von Quick-Sort: ein rekursives Sortier-Unterprogramm *)

    PROCEDURE DoQuick (Left,Right : CARDINAL);

      VAR Index : CARDINAL;

      BEGIN
        Index := FindPivot(Left,Right);
        IF Index # 0 THEN
          Index := Permute (Left,Right,SortArray[Index]);
          DoQuick (Left,Index-1);
          DoQuick (Index,Right);
        END;
      END DoQuick;


   (* das Hauptprogramm besteht lediglich aus einem Einsprung in die rekursi-
                                                          ve Sortier-Routine *)
    BEGIN
      DoQuick (first,last);
    END QuickSort;



(* ---  Sortieren nach dem Shell-Sort-Verfahren durch Index-Permutation ---- *)

  PROCEDURE IndexSort (VAR SortArray  : ARRAY OF SortType;
                       VAR Index      : ARRAY OF CARDINAL;  (* das Indexfeld *)
                           first,last : CARDINAL;
                           Lower      : Comparison;
                           Ascending  : BOOLEAN);

    VAR i,j,p : CARDINAL;


  (* spezielle Vergleichsfunktion, Berücksichtigung von "Ascending" *)

    PROCEDURE lower (VAR a,b : SortType) : BOOLEAN;

      BEGIN
        IF Ascending THEN
          RETURN Lower(a,b);
        ELSE
          RETURN Lower(b,a);
        END;
      END lower;


    PROCEDURE SwapIndex (VAR i,j : CARDINAL);     (* vertauscht zwei Indizes *)

      VAR temp : CARDINAL;

      BEGIN
        temp := j;
        j    := i;
        i    := temp;
      END SwapIndex;


  (* der Shell-Sort-Algorithmus mit Indexvertauschung *)

    BEGIN
      FOR i:=first TO last DO                      (* Indizes initialisieren *)
        Index[i] := i;
      END;
      p := last - first + 1;
      WHILE p > 1 DO
        p := p DIV 2;
        FOR i:=first TO last-p DO
          IF lower(SortArray[Index[i+p]],SortArray[Index[i]]) THEN
            SwapIndex (Index[i],Index[i+p]);
            j := i;
            WHILE (j >= first+p) AND lower(SortArray[Index[j]],
                                           SortArray[Index[j-p]]) DO
              SwapIndex (Index[j],Index[j-p]);
              j := j - p;
            END;
          END;
        END;
      END;
    END IndexSort;


  BEGIN
  (*  keine Initialisierungen notwendig!  *)
  END Sorting.