|
=={{header|Quackery}}==
[ stack ] is pq ( [ --> [ ) ▼
This uses code from [[Priority queue#Quackery]]'
[ pq share swap peek ] is pq.peek ( n --> x )
[ pq take swap poke pq put ] is pq.poke ( n x --> )
[ 1+ 2 / 1 - ] is parent ( n --> n )
[ 0 > ] is has-parent ( n --> b )
[ 2 * 1+ ] is child ( n --> n )
[ child pq share size < ] is has-child ( n --> b )
[ 1+ ] is sibling ( n --> n )
[ sibling pq share size < ] is has-sibling ( n --> b )
[ stack ] is comparison ( [ --> [ )
[ comparison share do ] is pq.compare ( x x --> b )
[ over size
rot 0 join pq put
[ dup has-parent while
dup parent
rot over pq.peek
2dup pq.compare iff
[ 2swap unrot pq.poke ]
again
pq.poke pq take ] is toheap ( h x --> h )
( toheap is not used in the heapsort, but
completes the set of heap operations )
[ dup pq.peek swap
[ dup has-child while
dup child
dup has-sibling if
[ dup sibling pq.peek
over pq.peek
pq.compare if sibling ]
dip over dup pq.peek
rot dip dup pq.compare iff
[ rot pq.poke ]
again
2drop ]
pq.poke ] is pq.heapify ( n --> )
[ behead
over [] = if done
swap -1 split
swap join pq put
0 pq.heapify
pq take swap ] is fromheap ( h --> h x )
[ dup pq put
[ i pq.heapify ]
pq take ] is makeheap ( [ --> h )
[ ]'[ comparison put
[] swap makeheap
dup size times
[ fromheap
nested rot join
swap ]
drop
comparison release ] is hsortwith ( [ --> [ )
[ hsortwith > ] is hsort ( [ --> [ )
▲<lang Quackery > [ [] swap pqwith >
▲ sizedup 2 /pqsize times
▲ [ frompq rot 2dropjoin swap ]
▲ [ stack drop ] is pq hsort ( [ --> [ )
[] 23 times [ 90 random 10 + join ]
say " " dup echo cr
''' Output:'''
<pre> [ 7145 62 1182 25 1550 1914 8745 9111 6225 7321 8991 8110 3963 1277 3542 2080 2599 7216 76 2081 88 7397 8284 80 87 ]
--> [ 10 11 1214 1516 19 20 2021 25 25 3542 3945 6245 6250 7163 7277 7380 73 7680 81 82 84 87 88 89 91 97 99 ]</pre>
</pre>
=={{header|Racket}}==
|