2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -1,8 +1,13 @@
|
|||
{{Sorting Algorithm}} {{wikipedia|Heapsort}}
|
||||
{{omit from|GUISS}}
|
||||
[[wp:Heapsort|Heapsort]] is an in-place sorting algorithm with worst case and average complexity of <span style="font-family: serif">O(''n'' log''n'')</span>.
|
||||
|
||||
<br>
|
||||
[[wp:Heapsort|Heapsort]] is an in-place sorting algorithm with worst case and average complexity of <span style="font-family: serif">O(''n'' log''n'')</span>.
|
||||
|
||||
The basic idea is to turn the array into a binary heap structure, which has the property that it allows efficient retrieval and removal of the maximal element.
|
||||
|
||||
We repeatedly "remove" the maximal element from the heap, thus building the sorted list from back to front.
|
||||
|
||||
Heapsort requires random access, so can only be used on an array-like data structure.
|
||||
|
||||
Pseudocode:
|
||||
|
|
@ -50,4 +55,7 @@ Pseudocode:
|
|||
root := child <span style="color: grey">''(repeat to continue sifting down the child now)''</span>
|
||||
'''else'''
|
||||
'''return'''
|
||||
|
||||
<br>
|
||||
Write a function to sort a collection of integers using heapsort.
|
||||
<br><br>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,135 @@
|
|||
* Heap sort 22/06/2016
|
||||
HEAPS CSECT
|
||||
USING HEAPS,R13 base register
|
||||
B 72(R15) skip savearea
|
||||
DC 17F'0' savearea
|
||||
STM R14,R12,12(R13) prolog
|
||||
ST R13,4(R15) "
|
||||
ST R15,8(R13) "
|
||||
LR R13,R15 "
|
||||
L R1,N n
|
||||
BAL R14,HEAPSORT call heapsort(n)
|
||||
LA R3,PG pgi=0
|
||||
LA R6,1 i=1
|
||||
DO WHILE=(C,R6,LE,N) for i=1 to n
|
||||
LR R1,R6 i
|
||||
SLA R1,2 .
|
||||
L R2,A-4(R1) a(i)
|
||||
XDECO R2,XDEC edit a(i)
|
||||
MVC 0(4,R3),XDEC+8 output a(i)
|
||||
LA R3,4(R3) pgi=pgi+4
|
||||
LA R6,1(R6) i=i+1
|
||||
ENDDO , end for
|
||||
XPRNT PG,80 print buffer
|
||||
L R13,4(0,R13) epilog
|
||||
LM R14,R12,12(R13) "
|
||||
XR R15,R15 "
|
||||
BR R14 exit
|
||||
PG DC CL80' ' local data
|
||||
XDEC DS CL12 "
|
||||
*------- heapsort(icount)----------------------------------------------
|
||||
HEAPSORT ST R14,SAVEHPSR save return addr
|
||||
ST R1,ICOUNT icount
|
||||
BAL R14,HEAPIFY call heapify(icount)
|
||||
MVC IEND,ICOUNT iend=icount
|
||||
DO WHILE=(CLC,IEND,GT,=F'1') while iend>1
|
||||
L R1,IEND iend
|
||||
LA R2,1 1
|
||||
BAL R14,SWAP call swap(iend,1)
|
||||
LA R1,1 1
|
||||
L R2,IEND iend
|
||||
BCTR R2,0 -1
|
||||
ST R2,IEND iend=iend-1
|
||||
BAL R14,SIFTDOWN call siftdown(1,iend)
|
||||
ENDDO , end while
|
||||
L R14,SAVEHPSR restore return addr
|
||||
BR R14 return to caller
|
||||
SAVEHPSR DS A local data
|
||||
ICOUNT DS F "
|
||||
IEND DS F "
|
||||
*------- heapify(count)------------------------------------------------
|
||||
HEAPIFY ST R14,SAVEHPFY save return addr
|
||||
ST R1,COUNT count
|
||||
SRA R1,1 /2
|
||||
ST R1,ISTART istart=count/2
|
||||
DO WHILE=(C,R1,GE,=F'1') while istart>=1
|
||||
L R1,ISTART istart
|
||||
L R2,COUNT count
|
||||
BAL R14,SIFTDOWN call siftdown(istart,count)
|
||||
L R1,ISTART istart
|
||||
BCTR R1,0 -1
|
||||
ST R1,ISTART istart=istart-1
|
||||
ENDDO , end while
|
||||
L R14,SAVEHPFY restore return addr
|
||||
BR R14 return to caller
|
||||
SAVEHPFY DS A local data
|
||||
COUNT DS F "
|
||||
ISTART DS F "
|
||||
*------- siftdown(jstart,jend)-----------------------------------------
|
||||
SIFTDOWN ST R14,SAVESFDW save return addr
|
||||
ST R1,JSTART jstart
|
||||
ST R2,JEND jend
|
||||
ST R1,ROOT root=jstart
|
||||
LR R3,R1 root
|
||||
SLA R3,1 root*2
|
||||
DO WHILE=(C,R3,LE,JEND) while root*2<=jend
|
||||
ST R3,CHILD child=root*2
|
||||
MVC SW,ROOT sw=root
|
||||
L R1,SW sw
|
||||
SLA R1,2 .
|
||||
L R2,A-4(R1) a(sw)
|
||||
L R1,CHILD child
|
||||
SLA R1,2 .
|
||||
L R3,A-4(R1) a(child)
|
||||
IF CR,R2,LT,R3 THEN if a(sw)<a(child) then
|
||||
MVC SW,CHILD sw=child
|
||||
ENDIF , end if
|
||||
L R2,CHILD child
|
||||
LA R2,1(R2) +1
|
||||
L R1,SW sw
|
||||
SLA R1,2 .
|
||||
L R3,A-4(R1) a(sw)
|
||||
L R1,CHILD child
|
||||
LA R1,1(R1) +1
|
||||
SLA R1,2 .
|
||||
L R4,A-4(R1) a(child+1)
|
||||
IF C,R2,LE,JEND,AND, if child+1<=jend and X
|
||||
CR,R3,LT,R4 THEN a(sw)<a(child+1) then
|
||||
L R2,CHILD child
|
||||
LA R2,1(R2) +1
|
||||
ST R2,SW sw=child+1
|
||||
ENDIF , end if
|
||||
IF CLC,SW,NE,ROOT THEN if sw^=root then
|
||||
L R1,ROOT root
|
||||
L R2,SW sw
|
||||
BAL R14,SWAP call swap(root,sw)
|
||||
MVC ROOT,SW root=sw
|
||||
ELSE , else
|
||||
B RETSFDW return
|
||||
ENDIF , end if
|
||||
L R3,ROOT root
|
||||
SLA R3,1 root*2
|
||||
ENDDO , end while
|
||||
RETSFDW L R14,SAVESFDW restore return addr
|
||||
BR R14 return to caller
|
||||
SAVESFDW DS A local data
|
||||
JSTART DS F "
|
||||
ROOT DS F "
|
||||
JEND DS F "
|
||||
CHILD DS F "
|
||||
SW DS F "
|
||||
*------- swap(x,y)-----------------------------------------------------
|
||||
SWAP SLA R1,2 x
|
||||
LA R1,A-4(R1) @a(x)
|
||||
SLA R2,2 y
|
||||
LA R2,A-4(R2) @a(y)
|
||||
L R3,0(R1) temp=a(x)
|
||||
MVC 0(4,R1),0(R2) a(x)=a(y)
|
||||
ST R3,0(R2) a(y)=temp
|
||||
BR R14 return to caller
|
||||
*------- ------ -------------------------------------------------------
|
||||
A DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1'
|
||||
DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74'
|
||||
N DC A((N-A)/L'A) number of items
|
||||
YREGS
|
||||
END HEAPS
|
||||
|
|
@ -1,58 +1,50 @@
|
|||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
#define ValType double
|
||||
#define IS_LESS(v1, v2) (v1 < v2)
|
||||
|
||||
void siftDown( ValType *a, int start, int count);
|
||||
|
||||
#define SWAP(r,s) do{ValType t=r; r=s; s=t; } while(0)
|
||||
|
||||
void heapsort( ValType *a, int count)
|
||||
{
|
||||
int start, end;
|
||||
|
||||
/* heapify */
|
||||
for (start = (count-2)/2; start >=0; start--) {
|
||||
siftDown( a, start, count);
|
||||
int max (int *a, int n, int i, int j, int k) {
|
||||
int m = i;
|
||||
if (j < n && a[j] > a[m]) {
|
||||
m = j;
|
||||
}
|
||||
if (k < n && a[k] > a[m]) {
|
||||
m = k;
|
||||
}
|
||||
return m;
|
||||
}
|
||||
|
||||
for (end=count-1; end > 0; end--) {
|
||||
SWAP(a[end],a[0]);
|
||||
siftDown(a, 0, end);
|
||||
void downheap (int *a, int n, int i) {
|
||||
while (1) {
|
||||
int j = max(a, n, i, 2 * i + 1, 2 * i + 2);
|
||||
if (j == i) {
|
||||
break;
|
||||
}
|
||||
int t = a[i];
|
||||
a[i] = a[j];
|
||||
a[j] = t;
|
||||
i = j;
|
||||
}
|
||||
}
|
||||
|
||||
void siftDown( ValType *a, int start, int end)
|
||||
{
|
||||
int root = start;
|
||||
|
||||
while ( root*2+1 < end ) {
|
||||
int child = 2*root + 1;
|
||||
if ((child + 1 < end) && IS_LESS(a[child],a[child+1])) {
|
||||
child += 1;
|
||||
}
|
||||
if (IS_LESS(a[root], a[child])) {
|
||||
SWAP( a[child], a[root] );
|
||||
root = child;
|
||||
}
|
||||
else
|
||||
return;
|
||||
void heapsort (int *a, int n) {
|
||||
int i;
|
||||
for (i = (n - 2) / 2; i >= 0; i--) {
|
||||
downheap(a, n, i);
|
||||
}
|
||||
for (i = 0; i < n; i++) {
|
||||
int t = a[n - i - 1];
|
||||
a[n - i - 1] = a[0];
|
||||
a[0] = t;
|
||||
downheap(a, n - i - 1, 0);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
int main()
|
||||
{
|
||||
int ix;
|
||||
double valsToSort[] = {
|
||||
1.4, 50.2, 5.11, -1.55, 301.521, 0.3301, 40.17,
|
||||
-18.0, 88.1, 30.44, -37.2, 3012.0, 49.2};
|
||||
#define VSIZE (sizeof(valsToSort)/sizeof(valsToSort[0]))
|
||||
|
||||
heapsort(valsToSort, VSIZE);
|
||||
printf("{");
|
||||
for (ix=0; ix<VSIZE; ix++) printf(" %.3f ", valsToSort[ix]);
|
||||
printf("}\n");
|
||||
int main () {
|
||||
int a[] = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1};
|
||||
int n = sizeof a / sizeof a[0];
|
||||
int i;
|
||||
for (i = 0; i < n; i++)
|
||||
printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
|
||||
heapsort(a, n);
|
||||
for (i = 0; i < n; i++)
|
||||
printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
|
||||
return 0;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -0,0 +1,81 @@
|
|||
>>SOURCE FORMAT FREE
|
||||
*> This code is dedicated to the public domain
|
||||
*> This is GNUCOBOL 2.0
|
||||
identification division.
|
||||
program-id. heapsort.
|
||||
environment division.
|
||||
configuration section.
|
||||
repository. function all intrinsic.
|
||||
data division.
|
||||
working-storage section.
|
||||
01 filler.
|
||||
03 a pic 99.
|
||||
03 a-start pic 99.
|
||||
03 a-end pic 99.
|
||||
03 a-parent pic 99.
|
||||
03 a-child pic 99.
|
||||
03 a-sibling pic 99.
|
||||
03 a-lim pic 99 value 10.
|
||||
03 array-swap pic 99.
|
||||
03 array occurs 10 pic 99.
|
||||
procedure division.
|
||||
start-heapsort.
|
||||
|
||||
*> fill the array
|
||||
compute a = random(seconds-past-midnight)
|
||||
perform varying a from 1 by 1 until a > a-lim
|
||||
compute array(a) = random() * 100
|
||||
end-perform
|
||||
|
||||
perform display-array
|
||||
display space 'initial array'
|
||||
|
||||
*>heapify the array
|
||||
move a-lim to a-end
|
||||
compute a-start = (a-lim + 1) / 2
|
||||
perform sift-down varying a-start from a-start by -1 until a-start = 0
|
||||
|
||||
perform display-array
|
||||
display space 'heapified'
|
||||
|
||||
*> sort the array
|
||||
move 1 to a-start
|
||||
move a-lim to a-end
|
||||
perform until a-end = a-start
|
||||
move array(a-end) to array-swap
|
||||
move array(a-start) to array(a-end)
|
||||
move array-swap to array(a-start)
|
||||
subtract 1 from a-end
|
||||
perform sift-down
|
||||
end-perform
|
||||
|
||||
perform display-array
|
||||
display space 'sorted'
|
||||
|
||||
stop run
|
||||
.
|
||||
sift-down.
|
||||
move a-start to a-parent
|
||||
perform until a-parent * 2 > a-end
|
||||
compute a-child = a-parent * 2
|
||||
compute a-sibling = a-child + 1
|
||||
if a-sibling <= a-end and array(a-child) < array(a-sibling)
|
||||
*> take the greater of the two
|
||||
move a-sibling to a-child
|
||||
end-if
|
||||
if a-child <= a-end and array(a-parent) < array(a-child)
|
||||
*> the child is greater than the parent
|
||||
move array(a-child) to array-swap
|
||||
move array(a-parent) to array(a-child)
|
||||
move array-swap to array(a-parent)
|
||||
end-if
|
||||
*> continue down the tree
|
||||
move a-child to a-parent
|
||||
end-perform
|
||||
.
|
||||
display-array.
|
||||
perform varying a from 1 by 1 until a > a-lim
|
||||
display space array(a) with no advancing
|
||||
end-perform
|
||||
.
|
||||
end program heapsort.
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
defmodule Sort do
|
||||
def heapSort(list) do
|
||||
len = length(list)
|
||||
heapify(List.to_tuple(list), div(len - 2, 2))
|
||||
|> heapSort(len-1)
|
||||
|> Tuple.to_list
|
||||
end
|
||||
|
||||
defp heapSort(a, finish) when finish > 0 do
|
||||
swap(a, 0, finish)
|
||||
|> siftDown(0, finish-1)
|
||||
|> heapSort(finish-1)
|
||||
end
|
||||
defp heapSort(a, _), do: a
|
||||
|
||||
defp heapify(a, start) when start >= 0 do
|
||||
siftDown(a, start, tuple_size(a)-1)
|
||||
|> heapify(start-1)
|
||||
end
|
||||
defp heapify(a, _), do: a
|
||||
|
||||
defp siftDown(a, root, finish) when root * 2 + 1 <= finish do
|
||||
child = root * 2 + 1
|
||||
if child + 1 <= finish and elem(a,child) < elem(a,child + 1), do: child = child + 1
|
||||
if elem(a,root) < elem(a,child),
|
||||
do: swap(a, root, child) |> siftDown(child, finish),
|
||||
else: a
|
||||
end
|
||||
defp siftDown(a, _root, _finish), do: a
|
||||
|
||||
defp swap(a, i, j) do
|
||||
{vi, vj} = {elem(a,i), elem(a,j)}
|
||||
a |> put_elem(i, vj) |> put_elem(j, vi)
|
||||
end
|
||||
end
|
||||
|
||||
(for _ <- 1..20, do: :rand.uniform(20)) |> IO.inspect |> Sort.heapSort |> IO.inspect
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
sub heap_sort ( @list is rw ) {
|
||||
sub heap_sort ( @list ) {
|
||||
for ( 0 ..^ +@list div 2 ).reverse -> $start {
|
||||
_sift_down $start, @list.end, @list;
|
||||
}
|
||||
|
|
@ -9,7 +9,7 @@ sub heap_sort ( @list is rw ) {
|
|||
}
|
||||
}
|
||||
|
||||
sub _sift_down ( $start, $end, @list is rw ) {
|
||||
sub _sift_down ( $start, $end, @list ) {
|
||||
my $root = $start;
|
||||
while ( my $child = $root * 2 + 1 ) <= $end {
|
||||
$child++ if $child + 1 <= $end and [<] @list[ $child, $child+1 ];
|
||||
|
|
|
|||
|
|
@ -1,45 +1,40 @@
|
|||
my @my_list = (2,3,6,23,13,5,7,3,4,5);
|
||||
heap_sort(\@my_list);
|
||||
print "@my_list\n";
|
||||
exit;
|
||||
#!/usr/bin/perl
|
||||
|
||||
sub heap_sort
|
||||
{
|
||||
my($list) = @_;
|
||||
my $count = scalar @$list;
|
||||
heapify($count,$list);
|
||||
my @a = (4, 65, 2, -31, 0, 99, 2, 83, 782, 1);
|
||||
print "@a\n";
|
||||
heap_sort(\@a);
|
||||
print "@a\n";
|
||||
|
||||
my $end = $count - 1;
|
||||
while($end > 0)
|
||||
{
|
||||
@$list[0,$end] = @$list[$end,0];
|
||||
sift_down(0,$end-1,$list);
|
||||
$end--;
|
||||
}
|
||||
sub heap_sort {
|
||||
my ($a) = @_;
|
||||
my $n = @$a;
|
||||
for (my $i = ($n - 2) / 2; $i >= 0; $i--) {
|
||||
down_heap($a, $n, $i);
|
||||
}
|
||||
for (my $i = 0; $i < $n; $i++) {
|
||||
my $t = $a->[$n - $i - 1];
|
||||
$a->[$n - $i - 1] = $a->[0];
|
||||
$a->[0] = $t;
|
||||
down_heap($a, $n - $i - 1, 0);
|
||||
}
|
||||
}
|
||||
sub heapify
|
||||
{
|
||||
my ($count,$list) = @_;
|
||||
my $start = ($count - 2) / 2;
|
||||
while($start >= 0)
|
||||
{
|
||||
sift_down($start,$count-1,$list);
|
||||
$start--;
|
||||
}
|
||||
}
|
||||
sub sift_down
|
||||
{
|
||||
my($start,$end,$list) = @_;
|
||||
|
||||
my $root = $start;
|
||||
while($root * 2 + 1 <= $end)
|
||||
{
|
||||
my $child = $root * 2 + 1;
|
||||
$child++ if($child + 1 <= $end && $list->[$child] < $list->[$child+1]);
|
||||
if($list->[$root] < $list->[$child])
|
||||
{
|
||||
@$list[$root,$child] = @$list[$child,$root];
|
||||
$root = $child;
|
||||
}else{ return }
|
||||
}
|
||||
sub down_heap {
|
||||
my ($a, $n, $i) = @_;
|
||||
while (1) {
|
||||
my $j = max($a, $n, $i, 2 * $i + 1, 2 * $i + 2);
|
||||
last if $j == $i;
|
||||
my $t = $a->[$i];
|
||||
$a->[$i] = $a->[$j];
|
||||
$a->[$j] = $t;
|
||||
$i = $j;
|
||||
}
|
||||
}
|
||||
|
||||
sub max {
|
||||
my ($a, $n, $i, $j, $k) = @_;
|
||||
my $m = $i;
|
||||
$m = $j if $j < $n && $a->[$j] > $a->[$m];
|
||||
$m = $k if $k < $n && $a->[$k] > $a->[$m];
|
||||
return $m;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,29 +1,25 @@
|
|||
/*REXX pgm sorts an array (modern Greek alphabet) using a heapsort algorithm. */
|
||||
@.=; @.1='alpha' ; @.6 ='zeta' ; @.11='lambda' ; @.16='pi' ; @.21='phi'
|
||||
@.2='beta' ; @.7 ='eta' ; @.12='mu' ; @.17='rho' ; @.22='chi'
|
||||
@.3='gamma' ; @.8 ='theta'; @.13='nu' ; @.18='sigma' ; @.23='psi'
|
||||
@.4='delta' ; @.9 ='iota' ; @.14='xi' ; @.19='tau' ; @.24='omega'
|
||||
@.5='epsilon'; @.10='kappa'; @.15='omicron'; @.20='upsilon'
|
||||
do #=1 while @.#\==''; end; #=#-1 /*find # entries*/
|
||||
/*REXX program sorts an array (names of modern Greek letters) using a heapsort algorithm*/
|
||||
@.=; @.1='alpha' ; @.6 ="zeta" ; @.11='lambda' ; @.16="pi" ; @.21='phi'
|
||||
@.2='beta' ; @.7 ="eta" ; @.12='mu' ; @.17="rho" ; @.22='chi'
|
||||
@.3='gamma' ; @.8 ="theta"; @.13='nu' ; @.18="sigma" ; @.23='psi'
|
||||
@.4='delta' ; @.9 ="iota" ; @.14='xi' ; @.19="tau" ; @.24='omega'
|
||||
@.5='epsilon'; @.10="kappa"; @.15='omicron'; @.20="upsilon"
|
||||
do #=1 while @.#\==''; end; #=#-1 /*find # entries.*/
|
||||
call show "before sort:"
|
||||
call heapSort #; say copies('▒',40) /*sort; show sep*/
|
||||
call heapSort #; say copies('▒', 40) /*sort; show sep.*/
|
||||
call show " after sort:"
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
heapSort: procedure expose @.; parse arg n; do j=n%2 by -1 to 1
|
||||
call shuffle j,n
|
||||
end /*j*/
|
||||
do n=n by -1 to 2
|
||||
_=@.1; @.1=@.n; @.n=_; call shuffle 1,n-1 /*swap and shuffle.*/
|
||||
end /*n*/
|
||||
return
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
shuffle: procedure expose @.; parse arg i,n; $=@.i /*obtain the parent*/
|
||||
do while i+i<=n; j=i+i; k=j+1
|
||||
if k<=n then if @.k>@.j then j=k
|
||||
if $>=@.j then leave
|
||||
@.i=@.j; i=j
|
||||
end /*while*/
|
||||
@.i=$; return
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
show: do e=1 for #; say ' element' right(e,length(#)) arg(1) @.e; end; return
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
heapSort: procedure expose @.; arg n; do j=n%2 by -1 to 1; call shuffle j,n; end /*j*/
|
||||
do n=n by -1 to 2; _=@.1; @.1=@.n; @.n=_; call shuffle 1,n-1
|
||||
end /*n*/ /* [↑] swap two elements; and shuffle.*/
|
||||
return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
shuffle: procedure expose @.; parse arg i,n; $=@.i /*obtain parent. */
|
||||
do while i+i<=n; j=i+i; k=j+1
|
||||
if k<=n then if @.k>@.j then j=k
|
||||
if $>=@.j then leave; @.i=@.j; i=j
|
||||
end /*while*/
|
||||
@.i=$; return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
show: do e=1 for #; say ' element' right(e,length(#)) arg(1) @.e; end; return
|
||||
|
|
|
|||
|
|
@ -1,26 +1,23 @@
|
|||
/*REXX pgm sorts an array (modern Greek alphabet) using a heapsort algorithm. */
|
||||
g = 'alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu xi',
|
||||
"omicron pi rho sigma tau upsilon phi chi psi omega" /*adjust # [↓] */
|
||||
do #=1 for words(g); @.#=word(g,#); end; #=#-1
|
||||
/*REXX program sorts a list (names of modern Greek letters) using a heapsort algorithm.*/
|
||||
parse arg g /*obtain optional argument from the CL.*/
|
||||
if g='' then g= 'alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu',
|
||||
"xi omicron pi rho sigma tau upsilon phi chi psi omega" /*adjust # [↓] */
|
||||
do #=1 for words(g); @.#=word(g,#); end; #=#-1
|
||||
call show "before sort:"
|
||||
call heapSort #; say copies('▒',40) /*sort; show sep*/
|
||||
call heapSort #; say copies('▒', 40) /*sort; show sep*/
|
||||
call show " after sort:"
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
heapSort: procedure expose @.; parse arg n; do j=n%2 by -1 to 1
|
||||
call shuffle j,n
|
||||
end /*j*/
|
||||
do n=n by -1 to 2
|
||||
_=@.1; @.1=@.n; @.n=_; call shuffle 1,n-1 /*swap and shuffle.*/
|
||||
end /*n*/
|
||||
return
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
shuffle: procedure expose @.; parse arg i,n; $=@.i /*obtain the parent*/
|
||||
do while i+i<=n; j=i+i; k=j+1
|
||||
if k<=n then if @.k>@.j then j=k
|
||||
if $>=@.j then leave
|
||||
@.i=@.j; i=j
|
||||
end /*while*/
|
||||
@.i=$; return
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
show: do e=1 for #; say ' element' right(e,length(#)) arg(1) @.e; end; return
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
heapSort: procedure expose @.; arg n; do j=n%2 by -1 to 1; call shuffle j,n; end /*j*/
|
||||
do n=n by -1 to 2; _=@.1; @.1=@.n; @.n=_; call shuffle 1,n-1
|
||||
end /*n*/ /* [↑] swap two elements; and shuffle.*/
|
||||
return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
shuffle: procedure expose @.; parse arg i,n; $=@.i /*obtain parent. */
|
||||
do while i+i<=n; j=i+i; k=j+1
|
||||
if k<=n then if @.k>@.j then j=k
|
||||
if $>=@.j then leave; @.i=@.j; i=j
|
||||
end /*while*/
|
||||
@.i=$; return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
show: do e=1 for #; say ' element' right(e,length(#)) arg(1) @.e; end; return
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue