===========================================================================
 BBS: The Abacus * HST/DS * Potterville MI
Date: 06-01-93 (19:51)             Number: 49
From: TOM HAMMOND                  Refer#: NONE
  To: WAYNE VENABLES                Recvd: NO  
Subj: Re: Sort...           1/2      Conf: (35) Quick Basi
---------------------------------------------------------------------------
VY>Use Cornel Huth's unrecursive QuickSort variant -- it's blazingly fast!

WV>I saw it here a LONG time ago... Where can I get it.

No sooner said than sent.

'==================================================================
'Date: 11-07-92 (13:59)             Number: 5280
'From: ZACK JONES                   Refer#: 4772
'Subj: Fast Sorting Algorithm.        Conf: (5) Quickbasic
'------------------------------------------------------------------
'QuickSort2 - QuickSort iterative (rather than recursive) by Cornel
'             Huth.

DEFINT A-Z
DECLARE SUB Fastsorti (inarray%(), lower%, upper%)
DECLARE SUB QuickSort2 (sortarray%(), lower%, upper%)

TYPE stacktype 'for QuickSort2
  low AS INTEGER
  hi AS INTEGER
END TYPE
CLS
FOR a = 1 TO 12
  count = 2 ^ a
  REDIM temp(1 TO count) AS INTEGER
  ' Generate a random array to test the sort.

  RANDOMIZE a
  FOR b = 1 TO count
    temp(b) = RND * 32766 + 1
  NEXT b

  s1# = TIMER
  DO
    start# = TIMER 'Wait for the beginning of a clock cycle.
  LOOP WHILE s1# = start#
  Fastsorti temp(), 1, count
  e1# = TIMER

  'Make the original arrays identical (no cheating! ;^)

  RANDOMIZE a
  FOR b = 1 TO count
    temp(b) = RND * 32766 + 1
  NEXT b

  s2# = TIMER
  DO
    start# = TIMER
  LOOP WHILE s2# = start#
  QuickSort2 temp(), 1, count
  e2# = TIMER

  ' A test to make sure it sorted it correctly.
  '
  'FOR chk = 1 TO Count
  '  PRINT Temp(chk);
  'NEXT chk
  'PRINT

  PRINT "FastSort: took"; e1# - s1#;
  PRINT TAB(30); "seconds to sort"; count; "entries."
  PRINT "MiscSort: took"; e2# - s2#;
  PRINT TAB(30); "seconds to sort"; count; "entries."
NEXT a

SUB Fastsorti (inarray%(), lower%, upper%)

  ' This routine was writen by Ryan Wellman.
  ' Copyright 1992, Ryan Wellman, all rights reserved.
  ' Released as Freeware October 22, 1992.
  ' You may freely use, copy & modify this code as you see
  ' fit. Under the condition that I am given credit for
  ' the original sort routine, and partial credit for modified
  ' versions of the routine.

  ' Thanks to Richard Vannoy who gave me the idea to compare
  ' entries further than 1 entry away.

  increment = (upper + lower)
  l2 = lower - 1

  DO
    increment = increment \ 2
    i2 = increment + l2
    FOR index = lower TO upper - increment
      IF inarray(index) > inarray(index + increment) THEN
        SWAP inarray(index), inarray(index + increment)
        IF index > i2 THEN
          cutpoint = index
          stopnow = 0
          DO
            index = index - increment
            IF inarray(index) > inarray(index + increment) THEN
              SWAP inarray(index), inarray(index + increment)
            ELSE
              stopnow = -1
              index = cutpoint
            END IF
          LOOP UNTIL stopnow
        END IF
      END IF
    NEXT index
  LOOP UNTIL increment <= 1
END SUB

SUB QuickSort2 (sortarray(), lower%, upper%)
  'QuickSort iterative (rather than recursive) by Cornel Huth
  DIM lstack(1 TO 128) AS stacktype   'our stack
  DIM sp AS INTEGER                   'out stack pointer
  sp = 1
  'maxsp = sp
  lstack(sp).low = lower%
  lstack(sp).hi = upper%
  sp = sp + 1
  DO
    sp = sp - 1
    low = lstack(sp).low
    hi = lstack(sp).hi
    DO
      i = low
      j = hi
      mid = (low + hi) \ 2
      compare = sortarray(mid)
      DO
        DO WHILE sortarray(i) < compare
          i = i + 1
        LOOP
        DO WHILE sortarray(j) > compare
          j = j - 1
        LOOP
        IF i <= j THEN
          SWAP sortarray(i), sortarray(j)
          i = i + 1
          j = j - 1
        END IF
      LOOP WHILE i <= j
      IF j - low < hi - i THEN
        IF i < hi THEN
          lstack(sp).low = i
          lstack(sp).hi = hi
          sp = sp + 1
        END IF
        hi = j
>>> Continued to next message
---
 * Origin: Night Shift BBS (314)635-7588 HST 14.4 (1:289/15)
SEEN-BY: 1/211 11/2 4 13/13 101/1 108/89 109/25 110/69 114/5 123/19 124/1