Data update
This commit is contained in:
Ingy döt Net
parent
8e4e15fa56
commit
72eb4943cb
1853 changed files with 35514 additions and 9441 deletions
|
|
@ -1,40 +1,48 @@
|
|||
/*REXX pgm sorts a stemmed array (numbers and/or chars) using the merge─sort algorithm.*/
|
||||
call init /*sinfully initialize the @ array. */
|
||||
call show 'before sort' /*show the "before" array elements. */
|
||||
say copies('▒', 75) /*display a separator line to the term.*/
|
||||
call merge # /*invoke the merge sort for the array*/
|
||||
call show ' after sort' /*show the "after" array elements. */
|
||||
exit 0 /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
init: @.=; @.1= '---The seven deadly sins---' ; @.4= "avarice" ; @.7= 'gluttony'
|
||||
@.2= '===========================' ; @.5= "wrath" ; @.8= 'sloth'
|
||||
@.3= 'pride' ; @.6= "envy" ; @.9= 'lust'
|
||||
do #=1 until @.#==''; end; #= #-1; return /*#: # of entries in @ array.*/
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
show: do j=1 for #; say right('element',20) right(j,length(#)) arg(1)":" @.j; end; return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
merge: procedure expose @. !.; parse arg n, L; if L=='' then do; !.=; L= 1; end
|
||||
if n==1 then return; h= L + 1
|
||||
if n==2 then do; if @.L>@.h then do; _=@.h; @.h=@.L; @.L=_; end; return; end
|
||||
m= n % 2 /* [↑] handle case of two items.*/
|
||||
call merge n-m, L+m /*divide items to the left ···*/
|
||||
call merger m, L, 1 /* " " " " right ···*/
|
||||
i= 1; j= L + m
|
||||
do k=L while k<j /*whilst items on right exist ···*/
|
||||
if j==L+n | !.i<=@.j then do; @.k= !.i; i= i + 1; end
|
||||
else do; @.k= @.j; j= j + 1; end
|
||||
end /*k*/
|
||||
return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
merger: procedure expose @. !.; parse arg n,L,T
|
||||
if n==1 then do; !.T= @.L; return; end
|
||||
if n==2 then do; h= L + 1; q= T + 1; !.q= @.L; !.T= @.h; return; end
|
||||
m= n % 2 /* [↑] handle case of two items.*/
|
||||
call merge m, L /*divide items to the left ···*/
|
||||
call merger n-m, L+m, m+T /* " " " " right ···*/
|
||||
i= L; j= m + T
|
||||
do k=T while k<j /*whilst items on left exist ···*/
|
||||
if j==T+n | @.i<=!.j then do; !.k= @.i; i= i + 1; end
|
||||
else do; !.k= !.j; j= j + 1; end
|
||||
end /*k*/
|
||||
return
|
||||
/***********************************************************************
|
||||
* After Paul van den Eertwegh reported that version 1 prodused
|
||||
* incorrect results (which observation I verified)
|
||||
* I decided to produce a nice program (instead of looking for the error)
|
||||
* This version supports only words in the list.
|
||||
* A version that can sort an array containing any string will follow
|
||||
* A suggestion from Paul:
|
||||
* By varying only one line
|
||||
* if word(a,1) > word(b,1) Then Do -- numeric or mixed ascending
|
||||
* if word(a,1) >> word(b,1) Then Do -- string ascending
|
||||
* if word(a,1) < word(b,1) Then Do -- numeric or mixed descending
|
||||
* if word(a,1) << word(b,1) Then Do -- string descending
|
||||
* you may perform the usual sorts.
|
||||
***********************************************************************/
|
||||
Parse Arg list
|
||||
If list='' Then
|
||||
unsortedList ='890 481 272 628 353 513 654 138 474 531'
|
||||
Else
|
||||
unsortedList = list
|
||||
sortedList = mergeSort(unsortedList)
|
||||
say 'list ='unsortedList
|
||||
say 'sorted='space(sortedList)
|
||||
Exit
|
||||
mergesort: Procedure
|
||||
Parse Arg a
|
||||
if words(a)=1 Then return a
|
||||
mid=words(a)%2+1
|
||||
l1=subword(a,1,mid-1)
|
||||
l2=subword(a,mid)
|
||||
l1 = mergesort( l1 )
|
||||
l2 = mergesort( l2 )
|
||||
return merge( l1, l2 )
|
||||
merge: Procedure
|
||||
Parse Arg a,b
|
||||
c=''
|
||||
Do while words(a)>0 & words(b)>0
|
||||
if word(a,1) > word(b,1) Then Do
|
||||
c=c word(b,1)
|
||||
b=subword(b,2)
|
||||
End
|
||||
Else Do
|
||||
c=c word(a,1)
|
||||
a=subword(a,2)
|
||||
End
|
||||
end
|
||||
c=c a
|
||||
c=c b
|
||||
return c
|
||||
|
|
|
|||
|
|
@ -1,67 +1,70 @@
|
|||
Main:
|
||||
call Generate
|
||||
call Show
|
||||
call Mergesort 1,n
|
||||
call Show
|
||||
exit
|
||||
|
||||
Generate:
|
||||
call Random,,12345
|
||||
n = 10
|
||||
do i = 1 to n
|
||||
stem.i = Random()
|
||||
end
|
||||
stem.0 = n
|
||||
return
|
||||
|
||||
Show:
|
||||
do i = 1 to n
|
||||
say right(i,2) right(stem.i,3)
|
||||
end
|
||||
say
|
||||
return
|
||||
|
||||
Mergesort:
|
||||
procedure expose stem. work.
|
||||
arg b,e
|
||||
if e-b < 1 then
|
||||
return
|
||||
if e-b = 1 then do
|
||||
if stem.b > stem.e then do
|
||||
t = stem.b; stem.b = stem.e; stem.e = t
|
||||
/***********************************************************************
|
||||
* Translating blanks in the array's elements lets me use Version 1
|
||||
***********************************************************************/
|
||||
Call Init
|
||||
unsortedList=''
|
||||
Do i=1 To arr.0
|
||||
If pos('00'x,arr.i)>0 Then Do
|
||||
'Sorry, array elements must not contain ''00''x characters'
|
||||
Exit
|
||||
End
|
||||
unsortedList=unsortedList translate(arr.i,'00'x,' ')
|
||||
End
|
||||
say 'Array :'
|
||||
Call show
|
||||
sortedList = mergeSort(unsortedList)
|
||||
Do i=1 To arr.0
|
||||
arr.i=translate(word(sortedList,i),' ','00'x)
|
||||
End
|
||||
Say ''
|
||||
Say 'Sorted:'
|
||||
Call show
|
||||
Exit
|
||||
show:
|
||||
Do i=1 To arr.0
|
||||
Say 'arr.'i'='arr.i
|
||||
End
|
||||
Return
|
||||
mergesort: Procedure
|
||||
Parse Arg a
|
||||
If words(a)=1 Then Return a
|
||||
mid=words(a)%2+1
|
||||
l1=subword(a,1,mid-1)
|
||||
l2=subword(a,mid)
|
||||
l1 = mergesort( l1 )
|
||||
l2 = mergesort( l2 )
|
||||
Return merge( l1, l2 )
|
||||
merge: Procedure
|
||||
Parse Arg a,b
|
||||
c=''
|
||||
Do while words(a)>0 & words(b)>0
|
||||
If word(a,1) > word(b,1) Then Do
|
||||
c=c word(b,1)
|
||||
b=subword(b,2)
|
||||
End
|
||||
Else Do
|
||||
c=c word(a,1)
|
||||
a=subword(a,2)
|
||||
End
|
||||
end
|
||||
return
|
||||
end
|
||||
m = (b+e)%2
|
||||
call Mergesort b,m
|
||||
call Mergesort m+1,e
|
||||
call Merger b,m,e
|
||||
return
|
||||
c=c a
|
||||
c=c b
|
||||
Return c
|
||||
|
||||
Merger:
|
||||
procedure expose stem. work.
|
||||
arg b,m,e
|
||||
i = b; j = m+1; k = b
|
||||
do while i <= m | j <= e
|
||||
select
|
||||
when i <= m & j <= e then do
|
||||
if stem.i <= stem.j then do
|
||||
work.k = stem.i; i = i+1
|
||||
end
|
||||
else do
|
||||
work.k = stem.j; j = j+1
|
||||
end
|
||||
k = k+1
|
||||
end
|
||||
when i<=m then do
|
||||
work.k = stem.i; i = i+1; k = k+1
|
||||
end
|
||||
otherwise do
|
||||
work.k = stem.j; j = j+1; k = k+1
|
||||
end
|
||||
end
|
||||
end
|
||||
do i = b to e
|
||||
stem.i = work.i
|
||||
end
|
||||
return
|
||||
init:
|
||||
arr.=0
|
||||
Call store '---The seven deadly sins---'
|
||||
Call store '==========================='
|
||||
Call store 'pride'
|
||||
Call store 'avarice'
|
||||
Call store 'wrath'
|
||||
Call store 'envy'
|
||||
Call store 'gluttony'
|
||||
Call store 'sloth'
|
||||
Call store 'lust'
|
||||
Return
|
||||
store:
|
||||
z=arr.0+1
|
||||
arr.z=arg(1)
|
||||
arr.0=z
|
||||
Return
|
||||
|
|
|
|||
|
|
@ -0,0 +1,67 @@
|
|||
Main:
|
||||
call Generate
|
||||
call Show
|
||||
call Mergesort 1,n
|
||||
call Show
|
||||
exit
|
||||
|
||||
Generate:
|
||||
call Random,,12345
|
||||
n = 10
|
||||
do i = 1 to n
|
||||
stem.i = Random()
|
||||
end
|
||||
stem.0 = n
|
||||
return
|
||||
|
||||
Show:
|
||||
do i = 1 to n
|
||||
say right(i,2) right(stem.i,3)
|
||||
end
|
||||
say
|
||||
return
|
||||
|
||||
Mergesort:
|
||||
procedure expose stem. work.
|
||||
arg b,e
|
||||
if e-b < 1 then
|
||||
return
|
||||
if e-b = 1 then do
|
||||
if stem.b > stem.e then do
|
||||
t = stem.b; stem.b = stem.e; stem.e = t
|
||||
end
|
||||
return
|
||||
end
|
||||
m = (b+e)%2
|
||||
call Mergesort b,m
|
||||
call Mergesort m+1,e
|
||||
call Merger b,m,e
|
||||
return
|
||||
|
||||
Merger:
|
||||
procedure expose stem. work.
|
||||
arg b,m,e
|
||||
i = b; j = m+1; k = b
|
||||
do while i <= m | j <= e
|
||||
select
|
||||
when i <= m & j <= e then do
|
||||
if stem.i <= stem.j then do
|
||||
work.k = stem.i; i = i+1
|
||||
end
|
||||
else do
|
||||
work.k = stem.j; j = j+1
|
||||
end
|
||||
k = k+1
|
||||
end
|
||||
when i<=m then do
|
||||
work.k = stem.i; i = i+1; k = k+1
|
||||
end
|
||||
otherwise do
|
||||
work.k = stem.j; j = j+1; k = k+1
|
||||
end
|
||||
end
|
||||
end
|
||||
do i = b to e
|
||||
stem.i = work.i
|
||||
end
|
||||
return
|
||||
Loading…
Add table
Add a link
Reference in a new issue