aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

50
Task/Sorting-algorithms-Heapsort/REXX/sorting-algorithms-heapsort-1.rexx
View file

@ -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

45
Task/Sorting-algorithms-Heapsort/REXX/sorting-algorithms-heapsort-2.rexx
View file

@ -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