Data update
This commit is contained in:
Ingy döt Net
parent
8e4e15fa56
commit
72eb4943cb
1853 changed files with 35514 additions and 9441 deletions
|
|
@ -0,0 +1,56 @@
|
|||
/******************************************************************
|
||||
* Translated from REXX Version 1a
|
||||
* with a little help from a friend:-)
|
||||
******************************************************************/
|
||||
Call Init
|
||||
Call show 'Array:'
|
||||
arr=mergeSort(arr)
|
||||
Say ''
|
||||
Call show 'Sorted:'
|
||||
Exit
|
||||
mergesort: Procedure
|
||||
Use Arg a
|
||||
If a~items=1 Then Return a
|
||||
mid=a~items%2+1
|
||||
l1=a~section(1,mid-1)
|
||||
l2=a~section(mid)
|
||||
l1 = mergesort( l1 )
|
||||
l2 = mergesort( l2 )
|
||||
Return merge( l1, l2 )
|
||||
|
||||
merge: Procedure
|
||||
Use Arg a,b
|
||||
c=.array~new
|
||||
Do while a~items>0 & b~items>0
|
||||
if a[1] > b[1] Then Do
|
||||
c~append(b[1])
|
||||
b=b~section(2)
|
||||
End
|
||||
Else Do
|
||||
c~append(a[1])
|
||||
a=a~section(2)
|
||||
End
|
||||
end
|
||||
c~appendAll(a)
|
||||
c~appendAll(b)
|
||||
Return c
|
||||
|
||||
init:
|
||||
arr=.array~new
|
||||
arr~append('---The seven deadly sins---')
|
||||
arr~append('===========================')
|
||||
arr~append('pride')
|
||||
arr~append('avarice')
|
||||
arr~append('wrath')
|
||||
arr~append('envy')
|
||||
arr~append('gluttony')
|
||||
arr~append('sloth')
|
||||
arr~append('lust')
|
||||
Return
|
||||
|
||||
show:
|
||||
Say arg(1)
|
||||
Do elem over arr
|
||||
Say elem
|
||||
End
|
||||
Return
|
||||
|
|
@ -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
|
||||
|
|
@ -1,86 +1,107 @@
|
|||
(append) list1 list2
|
||||
comment:
|
||||
=========
|
||||
#true
|
||||
(003) "append" list1 list2
|
||||
|
||||
(car) pair
|
||||
comment:
|
||||
=========
|
||||
#true
|
||||
(002) "car" pair
|
||||
|
||||
(cadr) pair
|
||||
=========
|
||||
#true
|
||||
(002) "cadr" pair
|
||||
|
||||
(cdr) pair
|
||||
comment:
|
||||
=========
|
||||
#true
|
||||
(002) "cdr" pair
|
||||
|
||||
(cddr) pair
|
||||
=========
|
||||
#true
|
||||
(002) "cddr" pair
|
||||
|
||||
(cons) one two
|
||||
comment:
|
||||
=========
|
||||
#true
|
||||
(003) "cons" one two
|
||||
|
||||
(list1a) item
|
||||
=========
|
||||
#true
|
||||
(002) "list" item
|
||||
|
||||
(map) function list
|
||||
comment:
|
||||
=========
|
||||
#true
|
||||
(003) "map" function list
|
||||
|
||||
(merge) comparator list1 list2
|
||||
comment:
|
||||
CONTINUE WITH COLLECT ARGUMENT
|
||||
#true
|
||||
(merge1) comparator list1 list2 nil
|
||||
(merge01) comparator list1 list2 nil
|
||||
|
||||
(merge1) comparator list1 list2 collect
|
||||
comment:
|
||||
(merge01) comparator list1 list2 collect
|
||||
LIST2 EXHAUSTED -> MERGED
|
||||
(null?) list2
|
||||
(append) (reverse) collect list1
|
||||
|
||||
(merge1) comparator list1 list2 collect
|
||||
comment:
|
||||
(merge01) comparator list1 list2 collect
|
||||
LIST1 EXHAUSTED -> MERGED
|
||||
(null?) list1
|
||||
(append) (reverse) collect list2
|
||||
|
||||
(merge1) comparator list1 list2 collect
|
||||
comment:
|
||||
(merge01) comparator list1 list2 collect
|
||||
TAKE FROM LIST2 (HANDLES ONE CASE)
|
||||
(003) comparator (car) list2 (car) list1
|
||||
(merge1) comparator list1 (cdr) list2 (cons) (car) list2 collect
|
||||
(merge01) comparator
|
||||
list1
|
||||
(cdr) list2
|
||||
(cons) (car) list2 collect
|
||||
|
||||
(merge1) comparator list1 list2 collect
|
||||
comment:
|
||||
(merge01) comparator list1 list2 collect
|
||||
TAKE FROM LIST1 (HANDLES TWO CASES)
|
||||
#true
|
||||
(merge1) comparator (cdr) list1 list2 (cons) (car) list1 collect
|
||||
(merge01) comparator
|
||||
(cdr) list1
|
||||
list2
|
||||
(cons) (car) list1 collect
|
||||
|
||||
(null?) value
|
||||
comment:
|
||||
=========
|
||||
#true
|
||||
(002) "null?" value
|
||||
|
||||
(reverse) list
|
||||
comment:
|
||||
=========
|
||||
#true
|
||||
(002) "reverse" list
|
||||
|
||||
(sort) comparator jumble
|
||||
comment:
|
||||
PREPARE JUMBLE AND PERFORM MERGE PASSES -> EXTRACT
|
||||
#true
|
||||
(car) (sort11) comparator (sort1) jumble
|
||||
(car) (sort02) comparator (sort01) jumble
|
||||
|
||||
(sort1) jumble
|
||||
comment:
|
||||
(sort01) jumble
|
||||
PREPARED JUMBLE
|
||||
#true
|
||||
(map) "list" jumble
|
||||
(map) list1a jumble
|
||||
|
||||
(sort11) comparator jumble
|
||||
comment:
|
||||
(sort02) comparator jumble
|
||||
WHEN ZERO LISTS THEN NIL
|
||||
(null?) jumble
|
||||
nil
|
||||
|
||||
(sort11) comparator jumble
|
||||
comment:
|
||||
(sort02) comparator jumble
|
||||
WHEN ONE LIST THEN ALREADY SORTED
|
||||
(null?) (cdr) jumble
|
||||
jumble
|
||||
|
||||
(sort11) comparator jumble
|
||||
comment:
|
||||
(sort02) comparator jumble
|
||||
REPEATEDLY MERGE ALONG LENGTH
|
||||
#true
|
||||
(sort11) comparator
|
||||
(cons) (merge) comparator (car) jumble (002) "cadr" jumble
|
||||
(sort11) comparator (002) "cddr" jumble
|
||||
(sort02) comparator
|
||||
(cons) (merge) comparator (car) jumble (cadr) jumble
|
||||
(sort02) comparator (cddr) jumble
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue