'===========================================================================
' Subject: BINARY TREE SORT ROUTINE          Date: 07-05-99 (18:28)       
' Author:  Daniel Davies                     Code: QB, QBasic, PDS        
' Origin:  ia53@rapid.co.uk                Packet: ALGOR.ABC
'===========================================================================
'TREE SORT ROUTINE
'by Daniel Davies
'arclight@pagans.org
'http://www.users.rapid.net.uk/ia53
'
'This program sorts data using a binary tree which is a very efficient
'way of sorting information,
'On my Pentium Pro 200, it takes less than 1.5 seconds to sort 20000
'records when it's uncompiled when it's compiled it takes less than .9
'of a second to sort the same array.
'To sort an array in ascending order call SortAscending and pass the array
'you want to be sorted as a parameter
'To sort an array in decending order call SortDecending and pass the array
'you want to be sorted as a parameter
'If you use any of these routines in your own program please give me credit
'and please contact me to tell me what your using it for.

DECLARE SUB SortAscending (sorted() AS INTEGER)
DECLARE SUB SortDecending (sorted() AS INTEGER)
DECLARE SUB traverse (start AS INTEGER, sorted() AS INTEGER, depth AS INTEGER, tree() AS ANY)
' $DYNAMIC
TYPE tree
  value AS INTEGER
  left AS INTEGER
  right AS INTEGER
END TYPE
DEFINT A-Z

CLEAR

REM $STATIC
SUB SortAscending (sorted() AS INTEGER)
records = UBOUND(sorted)
DIM tree(records) AS tree
FOR x = 1 TO records
  tree(x).value = -32768
  tree(x).left = -32768
  tree(x).right = -32768
NEXT x

tree(1).value = sorted(1)

free = 2
FOR x = 2 TO records
pointer = 1
written = 0
DO
  IF sorted(x) < tree(pointer).value THEN
   IF tree(pointer).left = -32768 THEN
      tree(pointer).left = free
      tree(free).value = sorted(x)
      free = free + 1
      written = 1
   ELSE
    pointer = tree(pointer).left
   END IF
 ELSE
   IF tree(pointer).right = -32768 THEN
      tree(pointer).right = free
      tree(free).value = sorted(x)
      free = free + 1
      written = 1
   ELSE
    pointer = tree(pointer).right
   END IF

 END IF
 LOOP UNTIL written = 1
NEXT x

traverse 1, sorted(), 1, tree()
END SUB

SUB SortDecending (sorted() AS INTEGER)
records = UBOUND(sorted)
DIM tree(records) AS tree
FOR x = 1 TO records
  tree(x).value = -32768
  tree(x).left = -32768
  tree(x).right = -32768
NEXT x

tree(1).value = sorted(1)

free = 2
FOR x = 2 TO records
pointer = 1
written = 0
DO
  IF sorted(x) > tree(pointer).value THEN
   IF tree(pointer).left = -32768 THEN
      tree(pointer).left = free
      tree(free).value = sorted(x)
      free = free + 1
      written = 1
   ELSE
    pointer = tree(pointer).left
   END IF
 ELSE
   IF tree(pointer).right = -32768 THEN
      tree(pointer).right = free
      tree(free).value = sorted(x)
      free = free + 1
      written = 1
   ELSE
    pointer = tree(pointer).right
   END IF

 END IF
 LOOP UNTIL written = 1
NEXT x

traverse 1, sorted(), 1, tree()

END SUB

SUB traverse (start AS INTEGER, sorted() AS INTEGER, depth AS INTEGER, tree() AS tree)

IF tree(start).left <> -32768 THEN traverse tree(start).left, sorted(), depth, tree()
sorted(depth) = tree(start).value
depth = depth + 1
IF tree(start).right <> -32768 THEN traverse tree(start).right, sorted(), depth, tree()

END SUB