===========================================================================
 BBS: The Abacus * HST/DS * Potterville, MI
Date: 03-09-93 (08:53)             Number: 257
From: QUINN TYLER JACKSON          Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: QBCIMR's SORT ALGO             Conf: (35) Quick Basi
---------------------------------------------------------------------------
Hello!

Let's talk about subHuthSortXXX (Array() AS XXXXXXX)

As Module Standards Technician of the QBCIMR BBS project, I am proposing
the following modified version of Cornel Huth's QuickSort2 as the
standard sorting algorithm of QBCIMR.  All technicians would be expected
to incorporate THIS sorting SUB into their programs, to allow for a
central sorting module, and to save redundant code.

Now, since there are several data types in QuickBASIC, and since AS ANY
is only for mixed-language calls, the name of the routine must be
slightly altered by datatype.  These are the names:

subHuthSortINT (Array() AS INTEGER)
subHuthSortLNG (Array() AS LONG)
subHuthSortSNG (Array() AS SINGLE)
subHuthSortDBL (Array() AS DOUBLE)
subHuthSortSTR (Array() AS STRING)

With those changes in the SUB header, the same algo handles all standard
datatypes.  And it's quick.  (Which is why I adopted it, Cornel!) Using
this scheme, there are five separate routines to be compiled, but there
is no getting around that in pure QuickBASIC code.  Imagine, though, if
ONE algorithm wasn't established as being standard?  Every module would
have its own unique sorting algoritm, and then things would really get
messy!

Quinn Tyler Jackson
QBCIMR Module Standards Technician

P.S. Credit to Cornel Huth.

___-ALGORITHM FOLLOWS-----
DECLARE SUB subHuthSortINT (Array() AS INTEGER)

' HuthSort - QuickSort iterative (rather than recursive) by Cornel Huth.
' With modifications by Quinn Tyler Jackson

' Proposed as the standard sort algorithm for the QBCIMR
' project.


DEFINT A-Z

TYPE StackType
  low AS INTEGER
  hi AS INTEGER
END TYPE

DIM SHARED aStack(1 TO 128) AS StackType
DIM StackPtr AS INTEGER

SUB subHuthSortINT (Array() AS INTEGER)
'              ^^^             ^^^^^^^
'               |                 |
'               |                 |
'               \                 /
'                 \             /
'                   chage these } LNG, LONG
'                   to suit any } SNG, SINGLE
'                      BASIC    } DBL, DOUBLE
'                    data type  } STR, STRING

  StackPtr = 1
  'maxsp = StackPtr
  aStack(StackPtr).low = LBOUND(Array)
  aStack(StackPtr).hi = UBOUND(Array)
  StackPtr = StackPtr + 1

  DO
    StackPtr = StackPtr - 1
    low = aStack(StackPtr).low
    hi = aStack(StackPtr).hi

    DO
      i = low
      j = hi
      mid = (low + hi) \ 2
      compare = Array(mid)

      DO
        DO WHILE Array(i) < compare
          i = i + 1
        LOOP

    DO WHILE Array(j) > compare
          j = j - 1
        LOOP

        IF i <= j THEN
          SWAP Array(i), Array(j)
          i = i + 1
          j = j - 1
        END IF

      LOOP WHILE i <= j

      IF j - low < hi - i THEN
        IF i < hi THEN
          aStack(StackPtr).low = i
          aStack(StackPtr).hi = hi
          StackPtr = StackPtr + 1
        END IF

        hi = j

      ELSE
        IF low < j THEN
          aStack(StackPtr).low = low
          aStack(StackPtr).hi = j
          StackPtr = StackPtr + 1
        END IF

        low = i
      END IF

    LOOP WHILE low < hi
    'IF StackPtr > maxsp THEN maxsp = StackPtr

  LOOP WHILE StackPtr <> 1
END SUB


 * SLMR 2.1a *

--- Maximus/2 2.01wb
 * Origin: The Nibble's Roost, Richmond BC Canada 604-244-8009 (1:153/918)
SEEN-BY: 1/211 11/2 4 13/13 101/1 108/89 109/25 110/69 114/5 123/19 124/1
SEEN-BY: 153/752 154/40 77 157/2 159/100 125 430 950 203/23 209/209 280/1
SEEN-BY: 390/1 396/1 15 397/2 2230/100 3603/20