%% src : http://www.math.ubc.ca/~cass/graphics/text/www/code/sort.inc
%% code de Bill Casselman, modifie par jpv, 18/10/2007
/qsortdict 8 dict def
qsortdict begin
% args: /comp a L R x
% effect: effects a partition into two pieces [L j] [i R]
% leaves i j on stack
/partition { 8 dict begin
/x exch def
/j exch def
/i exch def
/a exch def
load /comp exch def
{
{
a i get x comp exec not {
exit
} if
/i i 1 add def
} loop
{
x a j get comp exec not {
exit
} if
/j j 1 sub def
} loop
i j le {
% swap a[i] a[j]
a j a i get
a i a j get
put put
indices j indices i get
indices i indices j get
put put
/i i 1 add def
/j j 1 sub def
} if
i j gt {
exit
} if
} loop
i j
end } def
% args: /comp a L R
% effect: sorts a[L .. R] according to comp
/subsort {
% /c a L R
[ 3 1 roll ] 3 copy
% /c a [L R] /c a [L R]
aload aload pop
% /c a [L R] /c a L R L R
add 2 idiv
% /c a [L R] /c a L R (L+R)/2
3 index exch get
% /c a [L R] /c a L R x
partition
% /c a [L R] i j
% if j > L subsort(a, L, j)
dup
% /c a [L R] i j j
3 index 0 get gt {
% /c a [L R] i j
5 copy
% /c a [L R] i j /c a [L R] i j
exch pop
% /c a [L R] i j /c a [L R] j
exch 0 get exch
% ... /c a L j
subsort
} if
% /c a [L R] i j
pop dup
% /c a [L R] i i
% if i < R subsort(a, i, R)
2 index 1 get lt {
% /c a [L R] i
exch 1 get
% /c a i R
subsort
}{
4 { pop } repeat
} ifelse
} def
end
% args: /comp a
% effect: sorts the array a
% comp returns truth of x < y for entries in a
/quicksort { qsortdict begin
dup length 1 gt {
% /comp a
dup
% /comp a a
length 1 sub
% /comp a n-1
0 exch subsort
} {
pop pop
} ifelse
end } def
% ----------------------------------------
%% fin du code de Bill Casselman
%% syntaxe : array1 doublebubblesort --> array2 array3, array3 est
%% trie par ordre croissant et array2 correspond a la position des
%% indices de depart, ie si array1 = [3 2 4 1], alors array2 = [3 1 0 2]
%% code de Bill Casselman, modifie par jpv, 18/10/2007
%% http://www.math.ubc.ca/people/faculty/cass/graphics/text/www/
/doublequicksort {
qsortdict begin
/comp exch
/a exch def
a dup length /n exch def
/indices [0 1 n 1 sub {} for ] def
dup length 1 gt {
% /comp a
dup
% /comp a a
length 1 sub
% /comp a n-1
0 exch subsort
} {
pop pop
} ifelse
indices a
end
} def
/comp {lt} def
|