PillarSoft

Contributed by: Scott Tietjen

Every now and then, you might need to sort the contents of a simple stemmed variable array. The following snippet implements a "Merge Sort" algorithm -- it recursively calls itself to sort the first half of the list, and then calls itself again to sort the second half of the list, then the algorithm merges the two sorted halves back into order. This makes the algorithm one of the fastest possible (running close to order of magnitude time N Log2 N); however, it gets its speed by making use of a lot of memory -- it needs space to hold a complete copy of the key and index arrays, plus enough on the stack to handle the recursive sorting all the way down. When I used this on an MVS mainframe, it had no problems dealing with tens of thousands of entries to be sorted. (Contrast this with the simple bubble sort, which started running into trouble sorting just a few hundred entries.)

Notes:

1. Standard format array -- sucessive items in .1 thru .n, with n stored in .0
2. The key list is sorted ascending and "in place" -- when finished, item .1 will have the smallest value, and so on until .n has the largest value.
3. As this uses enough memory for itself, we have it sort special sortkey and index arrays, rather than trying to move all of the fields around in memory.
4. If you only need to sort a single stemmed variable, either call it SortKey., or replace all instances of SortKey. with your variable, and delete all lines containing SortIdx./WorkIdx.

/* Sorting several parallel stemmed vars StemA., StemB., StemC. etc. using a MergeSort */

Do I = 1 to StemA.0
  SortKey.I = StemA.I        /* copy the sort key to its own array */
  SortIdx.I = I              /* and create an index for it         */
  End I
SortKey.0 = StemA.0
SortIdx.0 = StemA.0

Call MergeSort 1 SortKey.0

Do I = 1 to SortIdx.0  /* Display the new virtually sorted arrays */
  J = SortIdx.I
  Say StemA.J StemB.J StemC.J
  End I

Exit

MergeSort: Procedure Expose SortKey. SortIdx.

Parse Arg Lo Hi .

If Lo = Hi
  Then Return

Len = Hi - Lo + 1
Piv = (Lo + Hi) % 2  /* determine midpoint: integer divide by two */

Call MergeSort Lo      Piv  /* recursive sort first half */
Call MergeSort (Piv+1) Hi   /* recursive sort  last half */

Do I = 0 to (Len-1)         /* copy current part of array */
  J = Lo + I
  WorkKey.I = SortKey.J
  WorkIdx.I = SortIdx.J
  End I

M1 = 0
M2 = Piv - Lo + 1

Do I = 0 to (Len-1)         /* merge the two halves together */
  J = Lo + I
  If M2 <= (Hi - Lo)
    Then Do
      If M1 <= (Piv - Lo)
        Then Do
          If WorkKey.M1 > WorkKey.M2
            Then Do
              SortKey.J = WorkKey.M2
              SortIdx.J = WorkIdx.M2
              M2        = M2 + 1
              End
            Else Do
              SortKey.J = WorkKey.M1
              SortIdx.J = WorkIdx.M1
              M1        = M1 + 1
              End
          End
        Else Do
          SortKey.J = WorkKey.M2
          SortIdx.J = WorkIdx.M2
          M2        = M2 + 1
          End
      End
    Else Do
      SortKey.J = WorkKey.M1
      SortIdx.J = WorkIdx.M1
      M1        = M1 + 1
      End
  End I

Return