🚀 go-pugleaf

A general purpose Quicksort for your toolset.

Scott Hemphill	hemphill@csvax.caltech.edu	...!ames!elroy!cit-vax!hemphill
-------------------------------------------------------------------------------
%!
% August 31, 1989  by Scott Hemphill
% I wrote this code, and hereby place it in the public domain, i.e. there are
% no copying restrictions of any kind.
%
% Quicksort an Array
%	Stack:	Before => After
%		array proc =>
% This Quicksort implementation will sort an array of arbitrary PostScript(tm)
% objects, since you provide the procedure that does the object comparisons.
% Your procedure should remove two objects from the stack, pushing true on
% the stack if the first object is strictly less than the second object in
% sort order, otherwise pushing false.  (E.g. if you wish to sort an array of
% strings alphabetically, or an array of numbers into increasing order, you
% can simply use the PostScript operator "lt".  See below for examples.)
% The array is sorted in place, and is not left on the stack, so you need
% another copy of it somewhere.

/qsortdict 7 dict def
qsortdict begin
   /q-compare 0 def		% user-supplied comparison procedure
   /q-array 1 def		% current sub-array being sorted by qsortsub
   /q-length 2 def		% length of q-array
   /q-left 3 def		% left scan index
   /q-right 4 def		% right scan index
   /q-last 5 def		% partitioning element
   /q-temp 6 def		% temporary array element
end

/qsort
{
   qsortdict begin
   /q-compare exch def
   qsortsub
   end
}
bind def

/qsortsub
{
   /q-array exch def
   /q-length q-array length def
   q-length 1 gt
   {
      /q-left 0 def
      /q-right q-length 1 sub def
      /q-last q-array q-right get def
      {
         {
            q-array q-left get q-last q-compare
            {/q-left q-left 1 add def}
            {exit}
            ifelse
         }
         loop
         {
            q-left q-right eq {exit} if
            q-array q-right get q-last q-compare
            {exit}
            {/q-right q-right 1 sub def}
            ifelse
         }
         loop
         q-left q-right eq {exit} if
         /q-temp q-array q-left get def
         q-array q-left q-array q-right get put
         q-array q-right q-temp put
      }
      loop
      q-array q-length 1 sub q-array q-left get put
      q-array q-left q-last put
      q-array q-left 1 add q-length q-left sub 1 sub getinterval
         q-array 0 q-left getinterval
         qsortsub
      qsortsub
   }
   if
}
bind def

% Implementation notes:
% 1. The numbers in the initial qsortdict definitions are just place holders
%    for the real definitions which will be made when qsort is invoked.
% 2. qsort is just a shell for the recursive procedure qsortsub, which does
%    the real work.
% 3. qsortsub is a straightforward implementation of the Quicksort algorithm.
%    It removes the array on the stack, and sorts it in place by calling itself
%    recursively on two pieces of the initial array.  Instead of passing the
%    initial array plus left and right indices, it passes a subarray, taking
%    advantage of the fact that the subarray shares the same memory as the
%    original array.  This involves slightly more overhead, but is cleaner
%    to implement.
% 4. The qsortdict dictionary is used at all recursion levels, but there are
%    no definition conflicts!  This is because all references to the dictionary
%    definitions happen before the two recursive qsortsub calls at the end.
% 5. There are quite a number of performance improvements to be made which have
%    been deliberately left out, for clarity.  One important improvement would
%    be to use a different procedure to sort small sub-arrays.  There is a lot
%    of time wasted sorting two-element arrays, for example.  Even as written,
%    however, you should see a significant improvement over insertion-sort or
%    other n^2 algorithms for moderately sized arrays.  Another improvement
%    might be to define all the qsortdict variables as one-element executable
%    arrays.  The variables can be set by storing a value into the array, and
%    read by executing the array.  The point is that the array itself can be
%    put in the qsortsub procedure instead of its name.  Each time you do this
%    you save one dictionary name lookup.

% DEMO

% This example uses the "lt" operator to do numeric comparisons:
%	[3 1 4 1 5 9 2 6 5] dup /lt load qsort ==


% The "lt" operator is used here to do an alphabetical comparisons of strings.
%	[(twas) (brillig) (and) (the) (slithy) (toves)] dup /lt load qsort ==

% This final example sorts the keys in a dictionary.  It performs the
% comparison with a 6-element procedure which converts the keys to strings.
% Since the strings have been exchanged, it uses a "gt" operator instead of
% "lt".  It would be faster to convert all of the keys in the dictionary to
% strings first, but this would waste more memory.  Note that particular
% care has been given to the comparison procedure.  Execution of the "bind"
% operator after the procedure definition converts the names "cvs", "exch",
% and "gt" to their corresponding operators.  The "//" lexical operator
% (in PostScript version 38.0) converts the names "thing1" and "thing2" to
% the actual strings (the locations in memory--not the contents of the
% strings).  This means that all 6 names in the procedure have been converted
% to the objects they refer to, and there are no dictionary name lookups
% during the execution of this procedure.
%	/arr [/Times-Roman findfont /CharStrings get {pop} forall] def
%	/thing1 128 string def
%	/thing2 128 string def
%	(initial array:) = arr ==
%	arr {//thing2 cvs exch //thing1 cvs gt} bind qsort
%	(final array:) = arr ==
-- 
Scott Hemphill	hemphill@csvax.caltech.edu	...!ames!elroy!cit-vax!hemphill