 # 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  */
/* ---------------------------------------------------------------- */

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```