Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.postscript > #1594 > unrolled thread

YA quicksort function

Back to article view | Back to comp.lang.postscript

Contents

  YA quicksort function luser- -droog <mijoryx@yahoo.com> - 2013-08-25 00:05 -0700
    Re: YA quicksort function Mark Carroll <mtbc@bcs.org> - 2013-08-25 09:50 +0100
    Re: YA quicksort function Scott Hemphill <hemphill@hemphills.net> - 2013-08-25 21:54 -0400
      Re: YA quicksort function luser- -droog <mijoryx@yahoo.com> - 2013-08-25 21:57 -0700
    Re: YA quicksort function luser- -droog <mijoryx@yahoo.com> - 2013-08-26 00:45 -0700
    Re: YA quicksort function luser- -droog <mijoryx@yahoo.com> - 2013-09-03 22:51 -0700
      Re: YA quicksort function luser- -droog <mijoryx@yahoo.com> - 2013-09-03 23:47 -0700
    Re: YA quicksort function jdaw1 <jdawiseman@gmail.com> - 2014-03-31 06:40 -0700
    Re: YA quicksort function luser- -droog <mijoryx@yahoo.com> - 2014-04-06 21:51 -0700

#1594 — YA quicksort function

%!
%sort.ps % quicksort for comparable base types
%
% exports 1 procedure:
%
%           array  qsort  -
%      array proc  qsort  -
% sort array contents in-place using proc or `lt` for comparisons
% (works on strings, too!)

7 dict begin
/qsortdict currentdict def 

%/args { dup 1 add copy -1 1 { -1 roll ==only( )=only } for pop ()= } def 

/swap { % a i j 
    2 index exch  % a i a j 
    4 copy get    % a i a j a i a_j 
    3 1 roll get  % a i a j a_j a_i 
    exch 4 1 roll % a i a_j a j a_i 
    put put 
} bind def 

% array left right pivotIndex
/partition { %4 args
    %4 dict begin
        %{pivotIndex right left arr}{exch def}forall
        %/pivotValue arr pivotIndex get def 
        %arr pivotIndex right swap
        %/storeIndex left def 
        %left 1 right 1 sub { % i 
            %arr 1 index get pivotValue lt { % i 
                %arr 1 index storeIndex swap
                %/storeIndex storeIndex 1 add def 
            %} if pop 
        %arr storeIndex right swap
        %storeIndex
    %end
    3 index 1 index get % a l r pI p
    4 index 3 index 3 index % a l r pI p  a r pI
    //swap exec % a l r pI p
    3 index % a l r pI p sI
    dup 1 5 index 1 sub { % a l r pI p sI  i
        6 index 1 index get 3 index cmp { % a l r pI p sI  i
            6 index exch 2 index % a l r pI p sI  a i sI
            //swap exec % a l r pI p sI
            1 add % a l r pI p sI+1
        }{ pop } ifelse
    } for % a l r pI p sI
    5 index 1 index 5 index % a l r pI p sI  a sI r
    //swap exec % a l r pI p sI
    6 1 roll pop pop pop pop pop 
} bind def 

% array left right
/quicksort { %3 args
    2 copy ge { pop pop pop }{
        3 copy
            2 copy exch sub 2 idiv % a l r arr left right pivotIndex
            2 index add % pivotIndex = l + _(r-l)/2_
            //partition exec  % a l r newpivotIndex
        4 copy 1 add 3 2 roll pop exch % a l r p a p+1 r
        7 3 roll % a p+1 r a l r p
        exch pop 1 sub % a p+1 r  a l p-1
        quicksort
        quicksort
    } ifelse
} bind def

/qsort {
    //qsortdict begin
    dup xcheck not{ {lt} }if
    /cmp exch def
    0 1 index length 1 sub quicksort
    end
} bind
end % qsortdict
def

currentfile flushfile %comment-out this line to test

[ 8 3 9 2 4 83 0 29 1 8 22 55 12 99 201 333 999]
dup qsort pstack
dup { gt } qsort pstack pop
(the quick fox jumped over the lazy dog) dup qsort pstack

[toc] | [next] | [standalone]

#1595

For what it's worth, years ago I wrote a mergesort,

/sortarray
{
  8 dict begin
  
  /lessthan exch def

  dup length 0 gt
  {
    /mergetwo
    {
      /first exch def
      /second exch def
      /result first length second length add array def
      
      /firstat 0 def
      /secondat 0 def     

      0 1 result length 1 sub
      {
        /resultat exch def

        firstat first length eq
        {
          result resultat second secondat second length secondat sub getinterval putinterval
          exit
        }
        if

        secondat second length eq
        {
          result resultat first firstat first length firstat sub getinterval putinterval
          exit
        }
        if

        /firstelement first firstat get def
        /secondelement second secondat get def
        
        firstelement secondelement lessthan
        {
          result resultat firstelement put
          /firstat firstat 1 add def
        }
        {
          result resultat secondelement put
          /secondat secondat 1 add def
        }
        ifelse
      }
      for

      result
    } def
    
    /mergeall
    {
      dup length 1 eq
      {
        0 get
      }
      {
        /previous exch def
        
        previous length 2 mod 0 eq
        {
          /next previous length 2 idiv array def
          /nextat 0 def

          0
        }
        {
          /next previous length 2 idiv 1 add array def
          /nextat 1 def

          next 0 previous 0 get put

          1
        }
        ifelse

        2 previous length 2 sub
        {
          dup 1 add previous exch get exch previous exch get mergetwo
          next nextat 3 -1 roll put
          /nextat nextat 1 add def
        }
        for

        next mergeall
      }
      ifelse
    } def
    
    [ exch { 1 array dup 3 1 roll 0 3 -1 roll put } forall ] mergeall
  }
  if

  end
} bind def

I'm not going to claim that it is all that great, and it badly needs
comments, but it works.

GS>[ (one) (two) (three) (four) (five) (six) ] { lt } sortarray ==
[(five) (four) (one) (six) (three) (two)]
GS>[ 1 2 9 8 7 4 5 6 3 ] { gt } sortarray ==     
[9 8 7 6 5 4 3 2 1]

-- Mark

[toc] | [prev] | [next] | [standalone]

#1596

luser- -droog <mijoryx@yahoo.com> writes:

> %!
> %sort.ps % quicksort for comparable base types

Heh.  I posted a quicksort to this newsgroup on September 1, 1989.  My
signature contained a UUCP address in addition to an Internet address.

Scott
-- 
Scott Hemphill	hemphill@alumni.caltech.edu
"This isn't flying.  This is falling, with style."  -- Buzz Lightyear

[toc] | [prev] | [next] | [standalone]

#1597

On Sunday, August 25, 2013 8:54:24 PM UTC-5, Scott Hemphill wrote:
> luser- -droog <mijoryx@yahoo.com> writes:
> 
> 
> 
> > %!
> 
> > %sort.ps % quicksort for comparable base types
> 
> 
> 
> Heh.  I posted a quicksort to this newsgroup on September 1, 1989.  My
> 
> signature contained a UUCP address in addition to an Internet address.
> 
> 
> 
> Scott

That's awesome. In fact, the whole thread is full of great stuff:
https://groups.google.com/d/topic/comp.lang.postscript/1jRHqI-7GW4/discussion

One tidbit I found interesting is that the original Apple LaserWriter,
discontinued in 1986, had version 23.0 of the interpreter, 
pre-packedarray, pre-immediate names. But I gather that immediate
names were available long before the 2nd Edition manual came out.

[toc] | [prev] | [next] | [standalone]

#1600

On Sunday, August 25, 2013 2:05:11 AM UTC-5, luser- -droog wrote:
> %!
> 
> %sort.ps % quicksort for comparable base types
> 
> %
> 
> % exports 1 procedure:
> 
> %
> 
> %           array  qsort  -
> 
> %      array proc  qsort  -
> 
> % sort array contents in-place using proc or `lt` for comparisons
> 
> % (works on strings, too!)
> 
> 
> 
> 7 dict begin
> 
> /qsortdict currentdict def 
> 
> 
> 
> %/args { dup 1 add copy -1 1 { -1 roll ==only( )=only } for pop ()= } def 
> 
> 
> 
> /swap { % a i j 
> 
>     2 index exch  % a i a j 
> 
>     4 copy get    % a i a j a i a_j 
> 
>     3 1 roll get  % a i a j a_j a_i 
> 
>     exch 4 1 roll % a i a_j a j a_i 
> 
>     put put 
> 
> } bind def 
> 
> 
> 
> % array left right pivotIndex
> 
> /partition { %4 args
> 
>     %4 dict begin
> 
>         %{pivotIndex right left arr}{exch def}forall
> 
>         %/pivotValue arr pivotIndex get def 
> 
>         %arr pivotIndex right swap
> 
>         %/storeIndex left def 
> 
>         %left 1 right 1 sub { % i 
> 
>             %arr 1 index get pivotValue lt { % i 
> 
>                 %arr 1 index storeIndex swap
> 
>                 %/storeIndex storeIndex 1 add def 
> 
>             %} if pop 
> 
>         %arr storeIndex right swap
> 
>         %storeIndex
> 
>     %end
> 
>     3 index 1 index get % a l r pI p
> 
>     4 index 3 index 3 index % a l r pI p  a r pI
> 
>     //swap exec % a l r pI p
> 
>     3 index % a l r pI p sI
> 
>     dup 1 5 index 1 sub { % a l r pI p sI  i
> 
>         6 index 1 index get 3 index cmp { % a l r pI p sI  i
> 
>             6 index exch 2 index % a l r pI p sI  a i sI
> 
>             //swap exec % a l r pI p sI
> 
>             1 add % a l r pI p sI+1
> 
>         }{ pop } ifelse
> 
>     } for % a l r pI p sI
> 
>     5 index 1 index 5 index % a l r pI p sI  a sI r
> 
>     //swap exec % a l r pI p sI
> 
>     6 1 roll pop pop pop pop pop 
> 
> } bind def 
> 
> 
> 
> % array left right
> 
> /quicksort { %3 args
> 
>     2 copy ge { pop pop pop }{
> 
>         3 copy
> 
>             2 copy exch sub 2 idiv % a l r arr left right pivotIndex
> 
>             2 index add % pivotIndex = l + _(r-l)/2_
> 
>             //partition exec  % a l r newpivotIndex
> 
>         4 copy 1 add 3 2 roll pop exch % a l r p a p+1 r
> 
>         7 3 roll % a p+1 r a l r p
> 
>         exch pop 1 sub % a p+1 r  a l p-1
> 
>         quicksort
> 
>         quicksort
> 
>     } ifelse
> 
> } bind def
> 
> 
> 
> /qsort {
> 
>     //qsortdict begin
> 
>     dup xcheck not{ {lt} }if
> 
>     /cmp exch def
> 
>     0 1 index length 1 sub quicksort
> 
>     end
> 
> } bind
> 
> end % qsortdict
> 
> def
> 
> 
> 
> currentfile flushfile %comment-out this line to test
> 
> 
> 
> [ 8 3 9 2 4 83 0 29 1 8 22 55 12 99 201 333 999]
> 
> dup qsort pstack
> 
> dup { gt } qsort pstack pop
> 
> (the quick fox jumped over the lazy dog) dup qsort pstack

It'll even sort a dictionary!
But you have sort the keys, too, to show it.

<<
0 5
1 12
2 67
3 900 
4 59
5 32
>> dup qsort 
dup [ exch { pop } forall ] dup qsort
pstack
{
    2 copy get 
    exch =only( )=only =only(\n)print
} forall



GPL Ghostscript 9.06 (2012-08-08)
Copyright (C) 2012 Artifex Software, Inc.  All rights reserved.
This software comes with NO WARRANTY: see the file PUBLIC for details.
[0 1 2 3 4 8 8 9 12 22 29 55 83 99 201 333 999]
[999 333 201 99 83 55 29 22 12 9 8 8 4 3 2 1 0]
(       acddeeeefghhijklmooopqrttuuvxyz)
[0 1 2 3 4 5]
-dict-
0 5
1 12
2 32
3 59
4 67
5 900
GS<1>

[toc] | [prev] | [next] | [standalone]

#1609

Found another one in the archive, an in-place insertion sort:

https://groups.google.com/d/topic/comp.lang.postscript/5nDEslzC-vg/discussion

[toc] | [prev] | [next] | [standalone]

#1610

On Wednesday, September 4, 2013 12:51:12 AM UTC-5, luser- -droog wrote:
> Found another one in the archive, an in-place insertion sort:
> 
> https://groups.google.com/d/topic/comp.lang.postscript/5nDEslzC-vg/discussion

Two more in this thread, shell-sort and bubble-sort:

https://groups.google.com/d/topic/comp.lang.postscript/5nDEslzC-vg/discussion

[toc] | [prev] | [next] | [standalone]

#1845

There is a HeapSort function within 
http://www.jdawiseman.com/papers/placemat/placemat.ps 
which you are welcome to re-use. 

HeapSort is, on average, a mite slower than QuickSort. But I like the uniformity and hence predictability of run time (worst, average, best: all about the same), and its worst case is guaranteed to be satisfactory.

[toc] | [prev] | [next] | [standalone]

#1851

Still more sorting routines at
http://www.tinaja.com/glib/presort.pdf
and
http://www.tinaja.com/glib/heapsort.pdf

of course.

-- 
BTW, put an end to word attachments!
http://www.linuxtoday.com/infrastructure/2002011100220OP

[toc] | [prev] | [standalone]

Back to top | Article view | comp.lang.postscript

csiph-web