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

    const
      MaxItem = 30000;

    type
      Item = word;
      Ar1K = array[1..MaxItem] of Item;

      (***** Selection sort routine.                                      *)
      (*                                                                  *)
      procedure SelectionSort ({update} var Data : Ar1K;
                               {input }     ItemsToSort : word);
      var
        Temp   : Item;
        Min,
        Index1,
        Index2 : word;
      begin
        for Index1 := 1 to pred(ItemsToSort) do
          begin
            Min := Index1;
            for Index2 := succ(Index1) to ItemsToSort do
              if Data[Index2] < Data[Min] then
                Min := Index2;
            Temp := Data[Min];
            Data[Min] := Data[Index1];
            Data[Index1] := Temp
          end
      end;        (* SelectionSort.                                       *)

      (***** Insertion sort routine.                                      *)
      (*                                                                  *)
      procedure InsertionSort ({update} var Data : Ar1K;
                               {input }     ItemsToSort : word);
      var
        Temp   : Item;
        Index1,
        Index2 : word;
      begin
        for Index1 := 2 to ItemsToSort do
          begin
            Temp := Data[Index1];
            Index2 := Index1;
            while (Data[pred(Index2)] > Temp) do
              begin
                Data[Index2] := Data[pred(Index2)];
                dec(Index2)
              end;
            Data[Index2] := Temp
          end
      end;        (* InsertionSort.                                       *)

      (***** Bubble sort routine.                                         *)
      (*                                                                  *)
      procedure BubbleSort ({update} var Data : Ar1K;
                            {input }     ItemsToSort : word);
      var
        Temp   : Item;
        Index1,
        Index2 : word;
      begin
        for Index1 := ItemsToSort downto 1 do
          for Index2 := 2 to Index1 do
            if (Data[pred(Index2)] > Data[Index2]) then
              begin
                Temp := Data[pred(Index2)];
                Data[pred(Index2)] := Data[Index2];
                Data[Index2] := Temp
              end
      end;        (* BubbleSort.                                          *)

      (***** Shell sort routine.                                          *)
      (*                                                                  *)
      procedure ShellSort ({update} var Data : Ar1K;
                           {input }     ItemsToSort : word);
      var
        Temp   : Item;
        Index1, Index2, Index3 : word;
      begin
        Index3 := 1;
        repeat
          Index3 := succ(3 * Index3)
        until (Index3 > ItemsToSort);
        repeat
          Index3 := (Index3 div 3);
          for Index1 := succ(Index3) to ItemsToSort do
            begin
              Temp := Data[Index1];
              Index2 := Index1;
              while (Data[(Index2 - Index3)] > Temp) do
                begin
                  Data[Index2] := Data[(Index2 - Index3)];
                  Index2 := (Index2 - Index3);
                  if (Index2 <= Index3) then
                    break
                end;
              Data[Index2] := Temp
            end
        until (Index3 = 1)
      end;        (* ShellSort.                                           *)

      (***** QuickSort routine.                                           *)
      (*                                                                  *)
      procedure QuickSort({update} var Data : Ar1K;
                          {input }     Left,
                                       Right : word);
      var
        Temp   : Item;
        Index1, Index2, Pivot  : word;
      begin
        Index1 := Left;
        Index2 := Right;
        Pivot := Data[(Left + Right) div 2];
        repeat
          while (Data[Index1] < Pivot) do
            inc(Index1);
          while (Pivot < Data[Index2]) do
            dec(Index2);
          if (Index1 <= Index2) then
            begin
              Temp := Data[Index1];
              Data[Index1] := Data[Index2];
              Data[Index2] := Temp;
              inc(Index1);
              dec(Index2)
            end
          until (Index1 > Index2);
          if (Left < Index2) then
            QuickSort(Data, Left, Index2);
          if (Index1 < Right) then
            QuickSort(Data, Index1, Right)
      end;        (* QuickSort.                                           *)

      (***** Radix Exchange sort routine.                                 *)
      (*                                                                  *)
      procedure RadixExchange ({update} var Data   : ar1K;
                               {input }     ItemsToSort,
                                            Left,
                                            Right  : word;
                                            BitNum : shortint);
      var
        Temp   : Item;
        Index1, Index2 : word;
      begin
        if (Right > Left) and ( BitNum >= 0) then
          begin
            Index1 := Left;
            Index2 := Right;
            repeat
              while (((Data[Index1] shr BitNum) AND 1) = 0)
              and (Index1 < Index2) do
                inc(Index1);
              while (((Data[Index2] shr BitNum) AND 1) = 1)
              and (Index1 < Index2) do
                dec(Index2);
              Temp := Data[Index1];
              Data[Index1] := Data[Index2];
              Data[Index2] := Temp
            until (Index2 = Index1);
            if (((Data[Right] shr BitNum) AND 1) = 0) then
              inc(Index2);
            RadixExchange(Data, ItemsToSort, Left, pred(Index2),
                          pred(BitNum));
            RadixExchange(Data, ItemsToSort, Index2, Right, pred(BitNum))
          end
      end;        (* RadixExchange.                                       *)

    (*
                                   - Guy
    ---
     þ DeLuxeý/386 1.25 #5060 þ

    *)

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