ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/PNL003.ZIP/SORTUNIT.PAS

Pascal/Delphi Source File | 1990-07-06 | 8.8 KB | 291 lines

unit SortUnit;

{ This unit contains all the sort routines for the 'All Sorts of Sorts'
  article in PNL003. The code is copyrighted by Pete Davis. This code may
  be distributed only in un-modified form and only accompanying the Pascal
  NewsLetter Issue #3.                                                     }

interface

const
  MaxSize = 1000;       { Maximum size of an Array                  }

type
  DataType = integer;   { Need to give our routine a data-type      }
  DatArray = array[1..MaxSize] of DataType;  { Our data array       }

procedure Bubble_Sort(Var List : DatArray; NumItems : integer);
procedure Select_Sort(Var List : DatArray; NumItems : integer);
procedure Insert_Sort(Var List : DatArray; NumItems : integer);
procedure Shell_Sort(Var List : DatArray; NumItems : integer);
procedure Merge_Sort(Var List : DatArray; Start, NumItems : integer);
procedure Quick_Sort(Var List : DatArray; Start, List_End : integer);


implementation

procedure exchange(Var Item1, Item2 : DataType);

{ This procedure will exchange Item1 with Item2. This procedure
  is local to this unit as it is used by many of the sort programs. }

var
  Temp: DataType;

begin
  Temp := Item1;
  Item1 := Item2;      { Switch Item1 and Item2 using Temp }
  Item2 := Temp;
end;


procedure Bubble_Sort(Var List : DatArray; NumItems : integer);

{ This procedure is the actual Bubble-sort. List is the array of
  data of type DataType. NumItems is the number of items in List. }

var
  Done  : boolean; { Find out when we are finished sorting! }
  Index : integer; { Use this as our Index into the array   }

begin
  Done := False;
  while not Done do
    begin
      Done := True;  { reset done to true }

      for Index := 1 to (NumItems - 1) do            { Go through the list }
        begin
          if List[Index] > List[Index + 1] then      { compare neighbors   }
            begin
              Exchange(List[Index], List[Index + 1]); { had to exchange one,}
              Done := False;                         { so not done yet!    }
            end; { if }
        end; { for }
    end; { while }
end; { Bubble_Sort }


procedure Select_Sort(Var List : DatArray; NumItems : integer);

{ This is the Selection Sort procedure. Parameters are the same as
  Bubble_Sort. To show the simplicity, I use only 4 lines of very
  straight-foward code. An alternate, and quicker method is to have
  a variable that checks whether or not an exchange was made in a
  given pass throught the inner loop. If an exchange was not made then
  the list is in order. This would keep the sort from trying to work on
  a list that is already in order.                                       }

var
  Inner_Loop,                { Pretty self explanitory. The inner }
  Outer_Loop  : integer;     { and outer indices into the arrays.}

begin
  for Outer_Loop := 1 to NumItems - 1 do
    for Inner_Loop := Outer_Loop + 1 to NumItems do
      if List[Inner_Loop] < List[Outer_Loop] then
        exchange(List[Inner_Loop], List[Outer_Loop]);
end;


procedure Insert_Sort(Var List : DatArray; NumItems : integer);

{ This is the Insertion Sort. This is a rather in-efficient version,
  as it uses an array. The problem is that the procedure Shift must
  move large portions of data in the list. This is much quicker in a
  linked-list implementation of the sort as the data isn't actually
  shifted in memory, only a couple links need to be changed.         }

var
  Cur,                     { Current position in array     }
  Index     : integer;     { Secondary index into array    }
  CurVal    : DataType;    { Value of item in Cur Position }


begin
  for Cur := 2 to NumItems do
    begin
      CurVal := List[Cur];
      Index := Cur - 1;

      { Start from the end and go to the beginning }
      while (Index > 0) and (CurVal < List[Index]) do
        begin
          { Move everything over to insert CurVal }
          List[Index + 1] := List[Index];
          dec(Index);
        end;
      List[Index+1] := CurVal;
    end;
end;


procedure Shell_Sort(Var List : DatArray; NumItems : integer);

{ This is the shell sort. It is much like the bubble sort, except
  instead of comparing and swapping adjacent elements, it is done
  over a distance of GAP.                                         }

var
  Index,                   { This is our index into the array }
  gap     : integer;       { This is the gap of the sort.     }
  done    : boolean;

begin
  gap := NumItems;
  while gap <> 1 do
    begin
      gap := gap div 2;    { Set our Gap to half of what it was }
      done := false;
      while not done do
        begin
          done := true;    { Set done to true }
          for Index := 1 to NumItems - Gap do
            if List[Index] > List[Index + Gap] then
              begin
                exchange(List[Index], List[Index + Gap]);
                done := false;  { If an exchange was made, we're not done. }
              end;
        end;
    end;
end;



procedure Merge_Sort(Var List : DatArray; Start, NumItems : integer);

{ This is the recursive Merge Sort. It starts by dividing the list
  in half, recursively taking care of both sides of the list. Then it
  puts the pieces back in the correct order in the Merge_List procedure. }


  procedure Merge_List(Var List : DatArray; Start, Mid, NumItems : integer);

  var
    Copy     : DatArray;     { This is where the results of the sort go }
    Left,                    { Left side of a half-list                 }
    Right,                   { Right side of of a half-list             }
    Index    : integer;      { Index into array.                        }


  begin
    Index := Start;
    Left  := Start;
    Right := Mid + 1;

    { Merge the half-lists }
    while (mid >= left) and (NumItems >= Right) do
      if List[Left] < List[Right] then
        begin
          Copy[Index] := List[Left];
          inc(Index); inc(Left);
        end
      else
        begin
          Copy[Index] := List[Right];
          inc(Index); inc(Right);
        end;

    { Take care of the left side }
    while Mid >= Left do
      begin
        Copy[Index] := List[Left];
        inc(Index); inc(Left);
      end;

    { Take care of the right side }
    while NumItems >= Right do
      begin
        Copy[Index] := List[Right];
        inc(Index); inc(Right);
      end;
    for Index := Start to NumItems do
      List[Index] := Copy[Index];
  end;


var
  Mid     : integer;

begin
  if Start < NumItems then
    begin
      Mid := (Start + NumItems) div 2;
      Merge_Sort(List, Start, Mid);
      Merge_Sort(List, Mid+1, NumItems);
      Merge_List(List, Start, Mid, NumItems);
    end;
end;



procedure Quick_Sort(Var List : DatArray; Start, List_End : integer);

{ This is the Quick_Sort Procedure. Like the Merge_Sort procedure
  it is recursive. First a pivot point is picked. Then the
  individual sides are sorted.                                     }



  procedure Split(Var List : DatArray; Start, List_End : integer;
                  Var PivotIndex : integer);

  { Move values less than pivot to the left of pivot and move
    values greater than pivot to the right.                        }

  var
    Pivot,
    LeftPointer,              { Pointers on the left and right side }
    RightPointer : integer;   { of the pivot point.                 }

  begin
    PivotIndex := (Start+List_End) div 2;
    Pivot := List[PivotIndex]; { Take middle item as pivot value }

    { Set the left and right pointers for moving through the Array. }
    LeftPointer := Start;
    RightPointer := List_End;

    repeat
      { Find all values on the wrong side of the pivot value
        and move them to the correct side.                   }


      { Start from the left and go towards the right }
      while (List[LeftPointer] <= Pivot) and
            (LeftPointer < List_End) do inc(LeftPointer);

      { Start from the right and go towards the left }
      while (List[RightPointer] > Pivot) and
            (RightPointer > Start) do dec(RightPointer);

      { If they're on the wrong side, then switch them }
      if LeftPointer < RightPointer then
          Exchange(List[LeftPointer], List[RightPointer]);
    until(LeftPointer >= RightPointer);


    { Put our Pivot into the correct location now. }
    exchange(List[PivotIndex], List[RightPointer]);
    PivotIndex := RightPointer;
  end;


var
  PivotIndex : integer;

begin
  if Start < List_End then
    begin
      { Split the table into to halves. }
      Split(List, Start, List_End, PivotIndex);

      { Take care of the left side. }
      Quick_Sort(List, Start, PivotIndex);

      { Now the right side.}
      Quick_Sort(List, PivotIndex+1, List_End);
    end;
end;

end. {End of unit}