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

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,17 +1,18 @@
/*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.*/
/*REXX pgm sorts an array (names of epichoric Greek letters) using a heapsort algorithm.*/
@.=; @.1= 'alpha' ; @.7 = "zeta" ; @.13= 'mu' ; @.19= "qoppa" ; @.25= 'chi'
@.2= 'beta' ; @.8 = "eta" ; @.14= 'nu' ; @.20= "rho" ; @.26= 'psi'
@.3= 'gamma' ; @.9 = "theta" ; @.15= 'xi' ; @.21= "sigma" ; @.27= 'omega'
@.4= 'delta' ; @.10= "iota" ; @.16= 'omicron'; @.22= "tau"
@.5= 'digamma'; @.11= "kappa" ; @.17= 'pi' ; @.23= "upsilon"
@.6= 'epsilon'; @.12= "lambda"; @.18= 'san' ; @.24= "phi"
do #=1 until @.#==''; end; #=# - 1 /*find # entries.*/
call show "before sort:"
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 @.; 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
do n=n by -1 to 2; _=@.1; @.1=@.n; @.n=_; call shuffle 1, n-1
end /*n*/ /* [↑] swap two elements; and shuffle.*/
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
@ -22,4 +23,4 @@ shuffle: procedure expose @.; parse arg i,n; $=@.i /*obtain
end /*while*/
@.i=$; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: do e=1 for #; say ' element' right(e,length(#)) arg(1) @.e; end; return
show: do s=1 for #; say ' element' right(s, length(#)) arg(1) @.s; end; return

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

@ -1,23 +1,23 @@
/*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
/*REXX pgm sorts an array (names of epichoric Greek letters) using a heapsort algorithm.*/
parse arg g /*obtain optional arguments from the CL*/
if g='' then g='alpha beta gamma delta digamma epsilon zeta eta theta iota kappa lambda',
"mu nu xi omicron pi san qoppa rho sigma tau upsilon phi chi psi omega"
#=words(g); do i=1 for #; @.i=word(g,i); end /*assign to @. */
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 @.; 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
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. */
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
show: do s=1 for #; say ' element' right(s, length(#)) arg(1) @.s; end; return