'heapsort.bas by Jerry Muelver, 2008.06.28
' HeapSort Demo. Note the "loop" and "blen" branches required
' because "rnd(0)" does not work in a "for" loop.
' Uses global array textarray$() in heapify and sort SUBs
 
INPUT "Number of items to sort: "; maxsize
print "Generating a random array with ";maxsize;" elements"
dim testarray$(maxsize+1)
' fill an array with random words
' Note: do not use the first (0) element of the array
i = 1
[loop]
 a = int(rnd(0)*26)+65
 a$ = chr$(a)
 b$ = ""
[blen]
  b = int(rnd(0)*26)+97
  b$ = b$+chr$(b)
if len(b$) < 4 then goto [blen]
rndStr$ = a$ + b$
testarray$(i) = rndStr$
i = i + 1
if i <= maxsize then goto [loop]
FOR i = 1 TO maxsize
PRINT testarray$(i);", ";
NEXT i
PRINT
print "Sorting...."
call hsort maxsize
FOR i = 1 TO maxsize
PRINT testarray$(i);", ";
NEXT i
PRINT
END
 
'-----------------------------------------------
SUB hsort inr
 
'first phase -- build heap
ix=INT(inr/2)
WHILE (ix >= 1)
 call heapify ix,inr
 ix=ix-1
WEND
 
'second phase -- put largest at end of array,
'use heapify to grab the next remaining largest
ix = inr
WHILE (ix > 1)
 call swap 1,ix
 call heapify 1,ix-1
 ix=ix-1
WEND
END SUB
 
'-----------------------------------------------
'instill heap condition
SUB heapify hleft,hright
ip = hleft
ic = 2*ip
WHILE (ic <= hright)
 IF (ic < hright) and (testarray$(ic+1) > testarray$(ic)) THEN ic = ic + 1
 IF (testarray$(ip) < testarray$(ic)) THEN call swap ic,ip
 ip = ic
 ic=2*ip
WEND
END SUB
 
'------------------------------------------------
SUB swap ij, ik
t$=testarray$(ij)
testarray$(ij)=testarray$(ik)
testarray$(ik)=t$
END SUB