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