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

    {I wrote a small Program to bench both sort routines we posted. It was an
    interesting test, however it did raise a couple questions For me, which I'll
    get to in a moment. (The following Program can be used as a skeleton For trying
    other sort routines too.)

    Needless to say, the routine you posted was dramatically faster than the one I
    posted, even though both routines are non-recursive simple sorts.

    The maximum efficient load of the routine you posted appears to be about 3000
    elements. After that, additonal elements add time exponentially. For example,
    it will sort 3000 elements in 5.1 seconds, but 5000 elements takes almost 16
    seconds. The sort I posted became un-benchable [bearable] at about 3000
    elements when it took over a minute to Complete. I didn't test it beyond this
    point.

    Here are the results from my 386 33Mhz machine-- your algorithm.

         500 Elements - 0.1   Seconds
        1000 Elements - 0.8   Seconds
        1500 Elements - 1.4   Seconds
        2000 Elements - 2.6   Seconds
        3000 Elements - 5.1   Seconds  <- Peak efficiency reached
        5000 Elements - 15.8  Seconds

    Here is the Program I used to benchmark with. I made it so that you could
    "tweak" portions of the sort and re-run the Program.

    Incidentally, I also Compiled this Program under Stony Brook's Pascal Plus and
    was suprised to find that it ran substantially slower. All optimizations on.

    Range Checking ($R+) exactly Doubled the time it took to sort.

    Changing "Span+1" to Succ(Span) and "total-1" to Pred(total) made the routine
    about 3% faster. However the routine then neglected to sort that last two
    elements. Adding "Inc(total,2)" solved the problem but I'm not sure why. I did
    not expect this behavior. Perhaps someone could explain why?

    I added a temporary Pointer Variable to your routine in place of the "NewStr('
    ...  ')" code you used to simplify it.

    and one last thing... Using OPRO's OpInline Function called
    "ExchangeLongInts()" to do the swapping instead of using a temporary Var
    increased speed another 2% (Evident at > 2000 elements.) However I did not
    include this so that anyone interested could Compile and run this without extra
    Units.
    }

    {$A+,B-,D-,E-,F-,G-,I+,L+,N-,O-,P-,Q+,R-,S+,T-,V-,X-,Y+}
    {$M 32768,0,655360}

    Program Sort_Test;  { Sorting Benchmark Using P. Beeftink's Algorithm }

    Type
       SmallArrPtr = ^SmallArr;
       SmallArr    = Array[1..10] of Char;   { Skip String & Length Byte }

       TTimeString = String[20];

    Var
       SortArray : Array[1..5000] of SmallArrPtr; { A LARGE Array }

       TickCount : LongInt Absolute $0040:$006C;
     { TickCount : LongInt VOLATILE Absolute $0040:$006C; } { For Pascal+ }
       Tstart,
       Ttime     : LongInt;

    {------------------------------------------------------------------------}
    Procedure StartTiming;
    begin
      TStart := TickCount;

      {start at the beginning of a tick!}
      Repeat Until TStart <> TickCount;

      TStart := TickCount;

    end;
    {------------------------------------------------------------------------}
    Procedure StopTiming;
    begin
      TTime := TickCount - TStart;
    end;
    {------------------------------------------------------------------------}
    Function Elapsed : TTimeString;
    Var Temp : TTimeString;
       Sec10 : LongInt;
    begin

      Sec10 := TTime * 2470 div 4497;
      Str( Sec10 : 4, Temp );

      if Temp[1] = ' ' then Temp[1] := '0';

      Inc( Temp[0] );
      Temp[ Length(Temp) ] := Temp[ Pred( Length( Temp ) ) ];
      Temp[ Pred( length( Temp ) ) ] := '.';

      Elapsed := Temp;
    end;
    {------------------------------------------------------------------------}
    Procedure MakeRandomStrings( NumtoMake : Word );
    Var RNum,
        I,S  : Word;
        Temp : String;
    begin

      Temp := '';
      Temp[0] := Chr( 10 );
      Randomize;

      For I := 1 to NumtoMake do
      begin

        For S := 1 to 10 do     { Create Random Strings 10 Chars in length }
        begin
          RNum := Random(26);
          Temp[S] := Chr( RNum + 65 );
        end;

        Move( Temp[1], SortArray[I]^, 10 );

      end;

    end; { Proc }
    {------------------------------------------------------------------------}
    Procedure KDSort( total : Word );
      {-My simple sort routine as posted in Pascal Echo }
      { With 2 slight modifications                     }
    Var
       i,j,
       Current : Word;
       TempPtr : Pointer;
    begin

      For I := 1 to total do
      begin

        Current := I;

        For J := Succ(I) to total do
        begin
          if SortArray[J]^ < SortArray[Current]^ then
          begin
             TempPtr            := SortArray[j];
             SortArray[j]       := SortArray[Current];
             SortArray[Current] := TempPtr;
          end; {if}
        end; {For}

      end; {For}

    end;
    {------------------------------------------------------------------------}
    Procedure PBSort(total : Integer);
      {-Peter Beeftink's Sort as Posted in Pascal Echo }
      { Also With slight modifications                 }
    Var
       I,j     : Integer;
       Span    : Integer;
       TempPtr : Pointer;
    begin

      Inc(total,2);   { Required to Compensate For PRED and SUCC ? }

      Span := total SHR $01;

      While Span > 0 do
      begin

        For I := Span to Pred(total) {total-1} do
        begin

          For j := (I - Succ(Span) {Span+1} ) Downto 1 do
            if (SortArray[j]^ <= SortArray[j+Span]^) then j := 1 else
            begin
              TempPtr           := SortArray[j];
              SortArray[j]      := SortArray[j+Span];
              SortArray[j+Span] := TempPtr;
            end;

        end; {For}

        Span := Span SHR $01; { This does help speed over Span div 2! }

      end; {WhIle}

    end;
    {------------------------------------------------------------------------}
    Procedure Do_Sorting( SortAmount : Word );
    begin

      MakeRandomStrings(SortAmount);

      Write('Sorting... ');

      StartTiming;

      PBSort(SortAmount); { Change to KDSort() to bench second sort routine }

      StopTiming;

      WriteLn(SortAmount:5,' Elements - ',Elapsed,' Seconds');

    end;
    {------------------------------------------------------------------------}
    Var C : Word;

    begin

      if MaxAvail < 5000 * Sizeof(SmallArr) then Halt; { not enough memory! }

      For C := 1 to 5000 do   { pre-allocate up front }
        GetMem(SortArray[C],Sizeof(SmallArr));

      Do_Sorting( 500   );   { Add more Do_Sorting()'s For whatever count }
      Do_Sorting( 1000  );   { you wish to test with.                     }
      Do_Sorting( 1500  );
      Do_Sorting( 2000  );
      Do_Sorting( 3000  );
      Do_Sorting( 5000  );

      { Un-comment the following if you wish to see the sorted output }

      {
      For C := 1 to 5000 do   { Change 5000 to the amount you sorted }
        WriteLn( SortArray[C]^ );

      For C := 1 to 5000 do
        FreeMem(SortArray[C],Sizeof(SmallArr));

    end.
    {
    I plugged in a QuickSort algorithm in the "skeleton" Program in my previous
    message to test perFormance. Here are the results:

         500 Elements - 0.1 Seconds
        1000 Elements - 0.2 Seconds
        1500 Elements - 0.4 Seconds
        2000 Elements - 0.6 Seconds
        3000 Elements - 0.9 Seconds
        5000 Elements - 1.8 Seconds

    Very fast indeed. I modified the algorithm to sort only by Pointers, and
    optimized a couple spots. Again, a slight speed increase is noted using OPRO's
    ExchangeLongInts() in leu of using temporary Variables in 1 spot. if you have
    OPRO, replace them and you reduce the number of instructions by 2 per
    iteration.

    This is a split-list recursive sort. Works by making a pass through the entire
    Array first and moves all "small" data to the left, and all "Large" data to the
    right. then it sorts each half seperately.

    Take the following code segment and "plug" it into the skeleton in my previous
    message. then change the "PBSort(SortAmount)" to "QuickSort(SortAmount)" to run
    the tests.

    Here is the code segment:

    {------------------------------------------------------------------------}
    Procedure QuickSort( total : Integer );
      {------------------------------------------}
      Procedure recQuickSort( L, R : Integer );
      Var K,I,J   : Integer;
          T,
          Temp    : Pointer;

      begin

        if L < R then
        begin
          T := SortArray[L];
          I := Pred(L);
          J := L;
          K := Succ(R);

          While Succ(J) < K do
           if SortArray[Succ(J)]^ < SmallArrPtr(T)^ then
           begin
             Inc(I,1);
             Inc(J,1);
             SortArray[I] := SortArray[J];
             SortArray[j] := T;
           end {if}
           else
           if SortArray[Succ(J)]^ > SmallArrPtr(T)^ then
           begin
             Dec(K,1);
             Temp := SortArray[K];
             SortArray[K] := SortArray[Succ(J)];
             SortArray[Succ(J)] := Temp;
           end {if}
           else
           Inc(J,1);

           recQuickSort(L,I);
           recQuickSort(K,R);

        end; { if L < R }

      end; { Proc recQuickSort }
      {------------------------------------------}

    begin

      recQuickSort(1,total);

    end;{QuickSort}
    {------------------------------------------------------------------------}

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