Heapsort Demo

[Jerry Muelver]

I just posted a HeapSort Demo at runbasic.wikispaces.com/HeapSort

Heapsort is not the fastest routine (though it beats Quicksort on an almost-sorted-already array), but it's fast enough, and it always takes the same time regardless of how sorted or unsorted the original array is. It also has the advantage of doing the sort inside the original array, so you don't need to build parallel array structures to get the job done.

[Janet]

Jerry, when I run the program, the first item never gets sorted. So that d, g, b, f, a, c, e gets sorted as d, a, b, c, e, f, g. Could you take a look at the demo again? I'd really like to use this sort routine. Thanks.

[Jerry Muelver]

Whoops.... Thought I had that fixed. Off-by-one error, dealing with zero-based arrays and one-based swapping. I will most certainly get tinkering on it!

[Janet]

Thanks.

[Jerry Muelver]

I fixed it, and put it on the wiki. Deal is, just don't use the first (0) element of the array for data. The heapify routines are 1-based. Here's the repaired code:

'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 

(Edit: fixed for OBO side-effect by changing array DIM to maxsize+1 per suggestion from Janet. Changed random word generation for wider range of letters.)