SORTSTEM: Algorithms and techniques for sorting stemmed "arrays"
Автор: Rex Swain
Дата: 1999
Источник: www.rexswain.com
/* ---------------------------------------------------------------- */
/* SORTSTEM.REX */
/* Algorithms and techniques for sorting a stemmed "array" */
/* 18 Oct 1998 Rex Swain, Independent Consultant, www.rexswain.com */
/* 02 Jan 1999 Added sort3(); added built-in timings */
/* ---------------------------------------------------------------- */
parse arg n /* How many elements to test? */
if n = '' then n = 200 /* Default to 200 */
call test n /* Run tests */
exit
/* ---------------------------------------------------------------- */
/* Suppose you want to sort the stem "foo." */
/* so that: is changed to: */
/* foo.0 = 4 foo.0 = 4 */
/* foo.1 = 25 foo.1 = -3 */
/* foo.2 = -3 foo.2 = 0 */
/* foo.3 = 0 foo.3 = 12 */
/* foo.4 = 12 foo.4 = 25 */
/* Due to limitations in the REXX language, the only reasonable way */
/* to do this is to pass the stem as a global to an internal */
/* subroutine. */
/* ---------------------------------------------------------------- */
/* If you want to sort using the dead minimum amount of code, use */
/* sort1, changing all occurences of "foo" to your stem name. */
/* This is a vanilla "bubble sort". */
/* Usage: */
/* /* create foo. */ */
/* call sort1 */
/* /* foo. is now sorted */ */
sort1: procedure expose foo.
n = foo.0
do i = 1 to n
do j = i+1 to n
if foo.i > foo.j then do
temp = foo.i
foo.i = foo.j
foo.j = temp
end
end
end
return
/* ---------------------------------------------------------------- */
/* While sort1 is small, it is also slow. A much faster algorithm, */
/* but requiring a little more code, is sort2. Again, change all */
/* occurences of "foo" to the name of your stem. */
/* Usage: */
/* /* create foo. */ */
/* call sort2 */
/* /* foo. is now sorted */ */
sort2: procedure expose foo.
n = foo.0
h = n
do while h > 1
h = h % 2
do i = 1 to n-h
j = i
k = h + i
do while foo.k < foo.j
temp = foo.j
foo.j = foo.k
foo.k = temp
if h >= j then leave
j = j - h
k = k - h
end
end
end
return
/* ---------------------------------------------------------------- */
/* Here is a recursive "quick sort" routine, which can be */
/* significantly faster than sort2 for large arrays. */
/* Again, change all occurences of "foo" to the name of your stem. */
/* Warning: A large array will generate extensive recursion, which */
/* may cause "control stack full" problems with some Rexx */
/* implementations. */
/* Usage: */
/* /* create foo. */ */
/* call sort3 */
/* /* foo. is now sorted */ */
sort3:
call sort3a 1,foo.0
return
sort3a: procedure expose foo.
parse arg first,last
k = (first+last) % 2
middle = foo.k
i = first
j = last
do while i <= j /* RHS: Like "do until i > j" but handles n=0 case */
do i = i while foo.i < middle
end
do j = j by -1 while middle < foo.j
end
if i <= j then do
if i < j then do /* RHS: Avoid swap if values are equal */
temp = foo.i
foo.i = foo.j
foo.j = temp
end
i = i + 1
j = j - 1
end
end
if j - first > last - i then do
if i < last then
call sort3a i,last
if first < j then
call sort3a first,j
end
else do
if first < j then
call sort3a first,j
if i < last then
call sort3a i,last
end
return
/* ---------------------------------------------------------------- */
/* If you need to sort several stems in your program, you can make */
/* several copies of the subroutines above, changing the name of */
/* the stem in each. */
/* But a better solution is to use a more general (albeit somewhat */
/* slower) approach that can sort any stem name. The subroutines */
/* below use the same logic as those above, but instead of */
/* referring to "foo.", they use the Rexx value() function to refer */
/* to a named stem. */
/* The only additional requirement is that prior to calling one of */
/* these subroutines, you must create a variable named "stemname" */
/* that contains the name of the stem to be sorted. */
/* Usage: */
/* /* create foo. and data. and etcetera */ */
/* stemname = 'foo.' */
/* call sortstem2 */
/* /* foo. is now sorted */ */
/* stemname = 'data.' */
/* call sortstem2 */
/* /* data. is now sorted */ */
/* /* etcetera */ */
sortstem1: procedure expose stemname (stemname)
n = value(stemname||0)
do i = 1 to n
do j = i+1 to n
if value(stemname||i) > value(stemname||j) then do
temp = value(stemname||i,value(stemname||j))
sink = value(stemname||j,temp)
end
end
end
return
sortstem2: procedure expose stemname (stemname)
n = value(stemname||0)
h = n
do while h > 1
h = h % 2
do i = 1 to n-h
j = i
k = h + i
do while value(stemname||k) < value(stemname||j)
temp = value(stemname||j,value(stemname||k))
sink = value(stemname||k,temp)
if h >= j then leave
j = j - h
k = k - h
end
end
end
return
sortstem3:
call sortstem3a 1,value(stemname||0)
return
sortstem3a: procedure expose stemname (stemname)
parse arg first,last
i = (first+last) % 2
middle = value(stemname||i)
i = first
j = last
do while i <= j /* RHS: Like "do until i > j" but handles n=0 case */
do i = i while value(stemname||i) < middle
end
do j = j by -1 while middle < value(stemname||j)
end
if i <= j then do
if i < j then do /* RHS: Avoid swap if values are equal */
temp = value(stemname||i,value(stemname||j))
sink = value(stemname||j,temp)
end
i = i + 1
j = j - 1
end
end
if j - first > last - i then do
if i < last then
call sortstem3a i,last
if first < j then
call sortstem3a first,j
end
else do
if first < j then
call sortstem3a first,j
if i < last then
call sortstem3a i,last
end
return
/* ---------------------------------------------------------------- */
/* You can avoid repeatedly re-defining the "stemname" variable by */
/* introducing an intermediate subroutine like those below. Its */
/* sole job is to create "stemname" and pass it along to sortstem. */
/* Just be careful because it's less obvious that a global variable */
/* is being created. */
/* Usage: */
/* /* create foo. and data. and etcetera */ */
/* call sortstemnamed2 'foo.' */
/* /* foo. is now sorted */ */
/* call sortstemnamed2 'data.' */
/* /* data. is now sorted */ */
/* /* etcetera */ */
sortstemnamed1: /* Note: this is NOT a procedure */
parse arg stemname /* Note: global being created or re-assigned */
call sortstem1
return
sortstemnamed2: /* Note: this is NOT a procedure */
parse arg stemname /* Note: global being created or re-assigned */
call sortstem2
return
sortstemnamed3: /* Note: this is NOT a procedure */
parse arg stemname /* Note: global being created or re-assigned */
call sortstem3
return
/* ---------------------------------------------------------------- */
/* Timing and verification stuff follows */
/* ---------------------------------------------------------------- */
test: procedure
parse arg n
algs = 3
cases = 4
case.1 = 'Ascend'
case.2 = 'Descend'
case.3 = 'Alternate'
case.4 = 'Random'
algw = 3 /* Display width */
casew = 9 /* Display width */
seed = time('S') /* Capture consistent seed */
say 'Elapsed times for' n 'elements:'
s = right('Alg',algw)
do case = 1 to cases
s = s right(case.case,casew)
end
say s right('Total',casew) /* Column titles */
do tech = 1 to 3 /* For each technique */
select
when tech = 1 then
todo = "call sort?"
when tech = 2 then
todo = "stemname = 'foo.' ; call sortstem?"
when tech = 3 then
todo = "call sortstemnamed? 'foo.'"
end
i = pos('?',todo)
say 'Technique:' delstr(todo,i,1)
do alg = 1 to algs /* For each algorithm */
td = left(todo,i-1) || alg || substr(todo,i+1)
do case = 1 to cases /* For each data case */
call create case /* Create foo. */
call time 'R' /* Reset timer */
interpret td /* Perform the sort */
elap.alg.case = time('E') /* Record elapsed time */
call verify alg,case /* Make sure sort worked! */
end /* Next case */
t = 0
s = right(alg,algw)
do case = 1 to cases
t = t + elap.alg.case
s = s right(elap.alg.case,casew)
end
say s right(t,casew)
end /* Next alg */
end /* Next technique */
return
create: procedure expose n foo. seed case.
parse arg case
select
when case = 1 then do /* case.1 = 'Ascend' */
do i = 1 to n
foo.i = i
end
end
when case = 2 then do /* case.2 = 'Descend' */
do i = 1 to n
foo.i = n-i+1
end
end
when case = 3 then do /* case.3 = 'Alternate' */
do i = 1 to n
if 0 = i // 2 then /* Even */
foo.i = i
else /* Odd */
foo.i = n-i
end
end
when case = 4 then do /* case.4 = 'Random' */
i = random(,,seed) /* Set seed */
do i = 1 to n
foo.i = random(1,n)
end
end
end
foo.0 = n
return
verify: procedure expose n foo.
parse arg alg,case
do i = 2 to n
j = i - 1
if foo.i < foo.j then do
say '*** Alg' alg 'Case' case 'sort did not work!'
leave
end
end
return