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

{
> Can you show me any version of thew quick sort that you may have? I've
> never seen it and never used it before. I always used an insertion sort
> For anything that I was doing.

Here is one (long) non-recursive version, quite fast.
}

Type
  _Compare  = Function(Var A, B) : Boolean;{ QuickSort Calls This }

{ --------------------------------------------------------------- }
{ QuickSort Algorithm by C.A.R. Hoare.  Non-Recursive adaptation  }
{ from "ALGORITHMS + DATA STRUCTURES = ProgramS" by Niklaus Wirth }
{ Prentice-Hall, 1976. Generalized For unTyped arguments.   }
{ --------------------------------------------------------------- }

Procedure QuickSort(V      : Pointer;   { To Array of Records }
                    Cnt    : Word;      { Record Count        }
                    Len    : Word;      { Record Length       }
                    ALessB : _Compare); { Compare Function    }

Type
  SortRec = Record
    Lt, Rt : Integer
  end;

  SortStak = Array [0..1] of SortRec;

Var
  StkT,
  StkM,
  Ki, Kj,
  M       : Word;
  Rt, Lt,
  I, J    : Integer;
  Ps      : ^SortStak;
  Pw, Px  : Pointer;

  Procedure Push(Left, Right : Integer);
  begin
    Ps^[StkT].Lt := Left;
    Ps^[StkT].Rt := Right;
    Inc(StkT);
  end;

  Procedure Pop(Var Left, Right : Integer);
  begin
    Dec(StkT);
    Left  := Ps^[StkT].Lt;
    Right := Ps^[StkT].Rt;
  end;

begin {QSort}
  if (Cnt > 1) and (V <> Nil) Then
  begin
    StkT := Cnt - 1;    { Record Count - 1 }
    Lt   := 1;          { Safety Valve    }

    { We need a stack of Log2(n-1) entries plus 1 spare For safety }

    Repeat
      StkT := StkT SHR 1;
      Inc(Lt);
    Until StkT = 0; { 1+Log2(n-1) }

    StkM := Lt * SizeOf(SortRec) + Len + Len; { Stack Size + 2 Records }

    GetMem(Ps, StkM);   { Allocate Memory    }

    if Ps = Nil Then
      RunError(215); { Catastrophic Error }

    Pw := @Ps^[Lt];   { Swap Area Pointer  }
    Px := Ptr(Seg(Pw^), Ofs(Pw^) + Len); { Hold Area Pointer  }

    Lt := 0;
    Rt := Cnt - 1;  { Initial Partition  }

    Push(Lt, Rt);   { Push Entire Table  }

    While StkT > 0 Do
    begin  { QuickSort Main Loop }
      Pop(Lt, Rt);   { Get Next Partition  }
      Repeat
        I := Lt; J := Rt;  { Set Work Pointers }

        { Save Record at Partition Mid-Point in Hold Area }
        M := (LongInt(Lt) + Rt) div 2;
        Move(Ptr(Seg(V^), Ofs(V^) + M * Len)^, Px^, Len);

        { Get Useful Offsets to speed loops }
        Ki := I * Len + Ofs(V^);
        Kj := J * Len + Ofs(V^);

        Repeat
          { Find Left-Most Entry >= Mid-Point Entry }
          While ALessB(Ptr(Seg(V^), Ki)^, Px^) Do
          begin
            Inc(Ki, Len);
            Inc(I)
          end;

          { Find Right-Most Entry <= Mid-Point Entry }
          While ALessB(Px^, Ptr(Seg(V^), Kj)^) Do
          begin
            Dec(Kj, Len);
            Dec(J)
          end;

          { if I > J, the partition has been exhausted }
          if I <= J Then
          begin
            if I < J Then  { we have two Records to exchange }
            begin
              Move(Ptr(Seg(V^), Ki)^, Pw^, Len);
              Move(Ptr(Seg(V^), Kj)^, Ptr(Seg(V^), Ki)^, Len);
              Move(Pw^, Ptr(Seg(V^), Kj)^, Len);
            end;

            Inc(I);
            Dec(J);
            Inc(Ki, Len);
            Dec(Kj, Len);
          end; { if I <= J }
        Until I > J;  { Until All Swaps Done }

        { We now have two partitions.  At left are all Records }
        { < X, and at right are all Records > X.  The larger   }
        { partition is stacked and we re-partition the residue }
        { Until time to pop a deferred partition.              }

        if (J - Lt) < (Rt - I) Then { Right-Most Partition is Larger }
        begin
          if I < Rt Then
            Push(I, Rt); { Stack Right Side }
          Rt := J;    { Resume With Left }
        end
        else  {  Left-Most Partition is Larger }
        begin
          if Lt < J Then
            Push(Lt, J); { Stack Left Side   }
          Lt := I;    { Resume With Right }
        end;

      Until Lt >= Rt;  { QuickSort is now Complete }
    end;
    FreeMem(Ps, StkM);   { Free Stack and Work Areas }
  end;
end; {QSort}

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