Another update from ingydotnet^djgoku
This commit is contained in:
Ingy döt Net
parent
91df62d461
commit
948b86eafa
7604 changed files with 108452 additions and 22726 deletions
|
|
@ -1,42 +1,29 @@
|
|||
/*REXX program sorts an array using the heapsort algorithm. */
|
||||
call gen@ /*generate the array elements. */
|
||||
call show@ 'before sort' /*show the before array elements*/
|
||||
call heapSort # /*invoke the heap sort. */
|
||||
call show@ ' after sort' /*show the after array elements*/
|
||||
exit /*stick a fork in it, we're done.*/
|
||||
/*──────────────────────────────────HEAPSORT subroutine─────────────────*/
|
||||
/*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*/
|
||||
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 @.; 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 subroutine──────────────────*/
|
||||
shuffle: procedure expose @.; parse arg i,n; _=@.i
|
||||
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
|
||||
/*──────────────────────────────────GEN@ subroutine─────────────────────*/
|
||||
gen@: @.=; @.1='---modern Greek alphabet letters---' /*default; title.*/
|
||||
@.2= copies('=', length(@.1)) /*match sep with ↑*/
|
||||
@.3='alpha' ; @.9 ='eta' ; @.15='nu' ; @.21='tau'
|
||||
@.4='beta' ; @.10='theta' ; @.16='xi' ; @.22='upsilon'
|
||||
@.5='gamma' ; @.11='iota' ; @.17='omicron' ; @.23='phi'
|
||||
@.6='delta' ; @.12='kappa' ; @.18='pi' ; @.24='chi'
|
||||
@.7='epsilon' ; @.13='lambd' ; @.19='rho' ; @.25='psi'
|
||||
@.8='zeta' ; @.14='mu' ; @.20='sigma' ; @.26='omega'
|
||||
|
||||
do #=1 while @.#\==''; end /*find how many entries in list. */
|
||||
#=#-1 /*adjust highItem slightly. */
|
||||
return
|
||||
/*──────────────────────────────────SHOW@ subroutine────────────────────*/
|
||||
show@: do j=1 for # /* [↓] display elements in array.*/
|
||||
say ' element' right(j,length(#)) arg(1)':' @.j
|
||||
end /*j*/
|
||||
say copies('■', 70) /*show a separator line. */
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,72 +1,26 @@
|
|||
/* REXX ***************************************************************
|
||||
* Translated from PL/I
|
||||
* 27.07.2013 Walter Pachl
|
||||
**********************************************************************/
|
||||
list='---letters of the modern Greek Alphabet---|'||,
|
||||
'==========================================|'||,
|
||||
'alpha|beta|gamma|delta|epsilon|zeta|eta|theta|'||,
|
||||
'iota|kappa|lambda|mu|nu|xi|omicron|pi|'||,
|
||||
'rho|sigma|tau|upsilon|phi|chi|psi|omega'
|
||||
Do i=0 By 1 While list<>''
|
||||
Parse Var list a.i '|' list
|
||||
End
|
||||
n=i-1
|
||||
|
||||
Call showa 'before sort'
|
||||
Call heapsort n
|
||||
Call showa ' after sort'
|
||||
Exit
|
||||
|
||||
heapSort: Procedure Expose a.
|
||||
Parse Arg count
|
||||
Call heapify count
|
||||
end=count-1
|
||||
do while end>0
|
||||
Call swap end,0
|
||||
end=end-1
|
||||
Call siftDown 0,end
|
||||
End
|
||||
Return
|
||||
|
||||
heapify: Procedure Expose a.
|
||||
Parse Arg count
|
||||
start=(count-2)%2
|
||||
Do while start>=0
|
||||
Call siftDown start,count-1
|
||||
start=start-1
|
||||
End
|
||||
Return
|
||||
|
||||
siftDown: Procedure Expose a.
|
||||
Parse Arg start,end
|
||||
root=start
|
||||
Do while root*2+1<= end
|
||||
child=root*2+1
|
||||
sw=root
|
||||
if a.sw<a.child Then
|
||||
sw=child
|
||||
child_1=child+1
|
||||
if child+1<=end & a.sw<a.child_1 Then
|
||||
sw=child+1
|
||||
if sw<>root Then Do
|
||||
Call swap root,sw
|
||||
root=sw
|
||||
End
|
||||
else
|
||||
return
|
||||
End
|
||||
Return
|
||||
|
||||
swap: Procedure Expose a.
|
||||
Parse arg x,y
|
||||
temp=a.x
|
||||
a.x=a.y
|
||||
a.y=temp
|
||||
Return
|
||||
|
||||
showa: Procedure Expose a. n
|
||||
Parse Arg txt
|
||||
Do j=0 To n-1
|
||||
Say 'element' format(j,2) txt a.j
|
||||
End
|
||||
Return
|
||||
/*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
|
||||
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 @.; 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
|
||||
|
|
|
|||
|
|
@ -0,0 +1,72 @@
|
|||
/* REXX ***************************************************************
|
||||
* Translated from PL/I
|
||||
* 27.07.2013 Walter Pachl
|
||||
**********************************************************************/
|
||||
list='---letters of the modern Greek Alphabet---|'||,
|
||||
'==========================================|'||,
|
||||
'alpha|beta|gamma|delta|epsilon|zeta|eta|theta|'||,
|
||||
'iota|kappa|lambda|mu|nu|xi|omicron|pi|'||,
|
||||
'rho|sigma|tau|upsilon|phi|chi|psi|omega'
|
||||
Do i=0 By 1 While list<>''
|
||||
Parse Var list a.i '|' list
|
||||
End
|
||||
n=i-1
|
||||
|
||||
Call showa 'before sort'
|
||||
Call heapsort n
|
||||
Call showa ' after sort'
|
||||
Exit
|
||||
|
||||
heapSort: Procedure Expose a.
|
||||
Parse Arg count
|
||||
Call heapify count
|
||||
end=count-1
|
||||
do while end>0
|
||||
Call swap end,0
|
||||
end=end-1
|
||||
Call siftDown 0,end
|
||||
End
|
||||
Return
|
||||
|
||||
heapify: Procedure Expose a.
|
||||
Parse Arg count
|
||||
start=(count-2)%2
|
||||
Do while start>=0
|
||||
Call siftDown start,count-1
|
||||
start=start-1
|
||||
End
|
||||
Return
|
||||
|
||||
siftDown: Procedure Expose a.
|
||||
Parse Arg start,end
|
||||
root=start
|
||||
Do while root*2+1<= end
|
||||
child=root*2+1
|
||||
sw=root
|
||||
if a.sw<a.child Then
|
||||
sw=child
|
||||
child_1=child+1
|
||||
if child+1<=end & a.sw<a.child_1 Then
|
||||
sw=child+1
|
||||
if sw<>root Then Do
|
||||
Call swap root,sw
|
||||
root=sw
|
||||
End
|
||||
else
|
||||
return
|
||||
End
|
||||
Return
|
||||
|
||||
swap: Procedure Expose a.
|
||||
Parse arg x,y
|
||||
temp=a.x
|
||||
a.x=a.y
|
||||
a.y=temp
|
||||
Return
|
||||
|
||||
showa: Procedure Expose a. n
|
||||
Parse Arg txt
|
||||
Do j=0 To n-1
|
||||
Say 'element' format(j,2) txt a.j
|
||||
End
|
||||
Return
|
||||
Loading…
Add table
Add a link
Reference in a new issue