Fast Sorting Algorith 1/2

 BBS: Inland Empire Archive
Date: 10-25-92 (02:14)             Number: 398
From: ALLAN ZACHARY                Refer#: NONE
  To: RYAN WELLMAN                  Recvd: NO  
Subj: Fast Sorting Algorith 1/2      Conf: (2) Quik_Bas

RW>        This is a sort routine that I just wrote.  It is extremely fast.
RW>It will sort an array with 16,383 random entries in 7.5 seconds on a
RW>386/40.  I would like to see your comments/modifications, and I would
RW>like to see if this routine is currently the fastest one in existance.

Looking through my QUIK_BAS echo archives, I found QuickSort2 by
Cornel Huth which is several times faster. Try it out. I removed
some of your comments for brevity, and modified the stopwatch a
little, for better accuracy.:)
                                   -Allan
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 14
  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 orriginal 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 modifided
  ' 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
      ELSE
        IF low < j THEN
          lstack(sp).low = low
          lstack(sp).hi = j
>>> Continued to next message

 * SLMR 2.1a * Okay, I pulled the pin. Now what? Hey! Where're ya going?