Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

YA quicksort function

149 views
Skip to first unread message

luser- -droog

unread,
Aug 25, 2013, 3:05:11 AM8/25/13
to
%!
%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

Mark Carroll

unread,
Aug 25, 2013, 4:50:28 AM8/25/13
to
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

Scott Hemphill

unread,
Aug 25, 2013, 9:54:24 PM8/25/13
to
luser- -droog <mij...@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 hemp...@alumni.caltech.edu
"This isn't flying. This is falling, with style." -- Buzz Lightyear

luser- -droog

unread,
Aug 26, 2013, 12:57:09 AM8/26/13
to
On Sunday, August 25, 2013 8:54:24 PM UTC-5, Scott Hemphill wrote:
> luser- -droog <mij...@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.


luser- -droog

unread,
Aug 26, 2013, 3:45:14 AM8/26/13
to
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>

luser- -droog

unread,
Sep 4, 2013, 1:51:12 AM9/4/13
to
Found another one in the archive, an in-place insertion sort:

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

luser- -droog

unread,
Sep 4, 2013, 2:47:28 AM9/4/13
to
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

jdaw1

unread,
Mar 31, 2014, 9:40:47 AM3/31/14
to
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.

luser- -droog

unread,
Apr 7, 2014, 12:51:16 AM4/7/14
to
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
0 new messages