[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]