Sorting algorithms/Heapsort: Difference between revisions

Content added Content deleted
m (→‎{{header|Perl 6}}: removed 'is rw')
m (→‎{{header|REXX}}: restructured 1st two programs, add/changed comments and whitespace.)
Line 2,839: Line 2,839:
<br>Indexing of the array (for this version) starts with &nbsp; '''1''' &nbsp; (one), &nbsp; but can be programmed to start with zero.
<br>Indexing of the array (for this version) starts with &nbsp; '''1''' &nbsp; (one), &nbsp; but can be programmed to start with zero.
<lang rexx>/*REXX program sorts an array (names of modern Greek letters) using a heapsort algorithm*/
<lang rexx>/*REXX program sorts an array (names of modern Greek letters) using a heapsort algorithm*/
@.=; @.1='alpha' ; @.6 ='zeta' ; @.11='lambda' ; @.16='pi' ; @.21='phi'
@.=; @.1='alpha' ; @.6 ="zeta" ; @.11='lambda' ; @.16="pi" ; @.21='phi'
@.2='beta' ; @.7 ='eta' ; @.12='mu' ; @.17='rho' ; @.22='chi'
@.2='beta' ; @.7 ="eta" ; @.12='mu' ; @.17="rho" ; @.22='chi'
@.3='gamma' ; @.8 ='theta'; @.13='nu' ; @.18='sigma' ; @.23='psi'
@.3='gamma' ; @.8 ="theta"; @.13='nu' ; @.18="sigma" ; @.23='psi'
@.4='delta' ; @.9 ='iota' ; @.14='xi' ; @.19='tau' ; @.24='omega'
@.4='delta' ; @.9 ="iota" ; @.14='xi' ; @.19="tau" ; @.24='omega'
@.5='epsilon'; @.10='kappa'; @.15='omicron'; @.20='upsilon'
@.5='epsilon'; @.10="kappa"; @.15='omicron'; @.20="upsilon"
do #=1 while @.#\==''; end; #=#-1 /*find # entries.*/
do #=1 while @.#\==''; end; #=#-1 /*find # entries.*/
call show "before sort:"
call show "before sort:"
call heapSort #; say copies('▒', 40) /*sort; show sep.*/
call heapSort #; say copies('▒', 40) /*sort; show sep.*/
call show " after sort:"
call show " after sort:"
exit /*stick a fork in it, we're all done. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
heapSort: procedure expose @.; parse arg n; do j=n%2 by -1 to 1
heapSort: procedure expose @.; arg n; do j=n%2 by -1 to 1; call shuffle j,n; end /*j*/
call shuffle j,n
do n=n by -1 to 2; _=@.1; @.1=@.n; @.n=_; call shuffle 1,n-1
end /*j*/
end /*n*/ /* [↑] swap two elements; and shuffle.*/
do n=n by -1 to 2
return
_=@.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*/
shuffle: procedure expose @.; parse arg i,n; $=@.i /*obtain parent. */
do while i+i<=n; j=i+i; k=j+1
do while i+i<=n; j=i+i; k=j+1
if k<=n then if @.k>@.j then j=k
if k<=n then if @.k>@.j then j=k
if $>=@.j then leave
if $>=@.j then leave; @.i=@.j; i=j
@.i=@.j; i=j
end /*while*/
end /*while*/
@.i=$; return
@.i=$; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: do e=1 for #; say ' element' right(e,length(#)) arg(1) @.e; end; return</lang>
show: do e=1 for #; say ' element' right(e,length(#)) arg(1) @.e; end; return</lang>
''output''' &nbsp; using the (default) Greek alphabet for input:
''output''' &nbsp; using the (default) Greek alphabet for input:
<pre>
<pre>
Line 2,922: Line 2,918:
===version 2===
===version 2===
This REXX version creates a stemmed array from a list.
This REXX version creates a stemmed array from a list.
<lang rexx>/*REXX program sorts an array (names of modern Greek letters) using a heapsort algorithm*/
<lang rexx>/*REXX program sorts a list (names of modern Greek letters) using a heapsort algorithm.*/
g= 'alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu xi',
g= 'alpha beta gamma delta epsilon zeta eta theta iota kappa lambda',
"omicron pi rho sigma tau upsilon phi chi psi omega" /*adjust # [↓] */
"mu nu xi omicron pi rho sigma tau upsilon phi chi psi omega" /*adjust # [↓] */
do #=1 for words(g); @.#=word(g,#); end; #=#-1
do #=1 for words(g); @.#=word(g,#); end; #=#-1
call show "before sort:"
call show "before sort:"
Line 2,931: Line 2,927:
exit /*stick a fork in it, we're all done. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
heapSort: procedure expose @.; parse arg n; do j=n%2 by -1 to 1
heapSort: procedure expose @.; arg n; do j=n%2 by -1 to 1; call shuffle j,n; end /*j*/
call shuffle j,n
do n=n by -1 to 2; _=@.1; @.1=@.n; @.n=_; call shuffle 1,n-1
end /*j*/
end /*n*/ /* [↑] swap two elements; and shuffle.*/
do n=n by -1 to 2
return
_=@.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*/
shuffle: procedure expose @.; parse arg i,n; $=@.i /*obtain parent. */
do while i+i<=n; j=i+i; k=j+1
do while i+i<=n; j=i+i; k=j+1
if k<=n then if @.k>@.j then j=k
if k<=n then if @.k>@.j then j=k
if $>=@.j then leave
if $>=@.j then leave; @.i=@.j; i=j
@.i=@.j; i=j
end /*while*/
end /*while*/
@.i=$; return
@.i=$; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: do e=1 for #; say ' element' right(e,length(#)) arg(1) @.e; end; return</lang>
show: do e=1 for #; say ' element' right(e,length(#)) arg(1) @.e; end; return</lang>
'''output''' &nbsp; is the same as the 1<sup>st</sup> REXX version.
'''output''' &nbsp; is the same as the 1<sup>st</sup> REXX version.


Retrieved from "https://rosettacode.org/wiki/Sorting_algorithms/Heapsort"