DEFINT A-Z

DECLARE SUB sortShell (array() AS INTEGER)
DECLARE SUB sortBubble (array() AS INTEGER)
DECLARE SUB sortTopDown (array() AS INTEGER)
DECLARE SUB sortQuickItr (array() AS INTEGER)
DECLARE SUB sortQuickRec (array() AS INTEGER, lf AS INTEGER, rt AS INTEGER)

REDIM init(0) AS INTEGER, cpy(0) AS INTEGER
DIM startTime AS SINGLE, tempTime AS SINGLE, numItems AS INTEGER

RANDOMIZE TIMER
CLS
PRINT "This program compares four different sorting algorithms (Bubble"
PRINT "Sort, Top Down Sort, Shell Sort, and Quick Sort.) With some"
PRINT "tweaking, these routines can be used to sort any type of data."
PRINT
INPUT "Size of array"; numItems
REDIM init(0 TO numItems - 1) AS INTEGER
REDIM cpy(0 TO numItems - 1) AS INTEGER
PRINT "Creating set of random numbers..."
FOR i% = LBOUND(init) TO UBOUND(init)
	init(i%) = INT(RND * 256)
NEXT i%

FOR j% = 0 TO 3

	' Copy unsorted array
	FOR i% = LBOUND(init) TO UBOUND(init)
		cpy(i%) = init(i%)
	NEXT i%

	' Initialize timer
	tempTime = TIMER
	DO
		startTime = TIMER
	LOOP WHILE tempTime = startTime

	' Go!
	SELECT CASE j%
		CASE 0
			PRINT "Bubble";
			sortBubble cpy()
		CASE 1
			PRINT "Top Down";
			sortTopDown cpy()
		CASE 2
			PRINT "Shell";
			sortShell cpy()
		CASE 3
			PRINT "Quick";
			sortQuickItr cpy()
	END SELECT

	' Final time
	PRINT " Sort - Done in"; TIMER - startTime; "seconds."

	IF 0 THEN
		' Display initial array
		COLOR 4
		LOCATE 3, 1
		FOR i% = LBOUND(init) TO UBOUND(init)
			IF (init(i%) < 16) THEN PRINT "0";
			PRINT HEX$(init(i%)); " ";
		NEXT i%
	END IF

	IF 0 THEN
		' Display sorted array (highlight mistakes if any)
		COLOR 1
		LOCATE 3, 1
		IF (LBOUND(cpy) < 16) THEN PRINT "0";
		PRINT HEX$(cpy(LBOUND(cpy))); " ";
		FOR i% = LBOUND(cpy) + 1 TO UBOUND(cpy)
			IF (cpy(i%) >= cpy(i% - 1)) THEN COLOR 2 ELSE COLOR 4
			IF (cpy(i%) < 16) THEN PRINT "0";
			PRINT HEX$(cpy(i%)); " ";
		NEXT i%
		COLOR 7
		SLEEP
	END IF
NEXT j%

''
'' Bubble Sort
''
SUB sortBubble (array() AS INTEGER)
	DIM doAgain AS INTEGER
	DIM max AS INTEGER

	max = UBOUND(array) - 1
	DO
		doAgain = 0
		FOR i% = 0 TO max
			IF (array(i%) > array(i% + 1)) THEN
				SWAP array(i%), array(i% + 1)
				doAgain = -1
			END IF
		NEXT i%
		max = max - 1
	LOOP WHILE doAgain
END SUB

''
'' QuickSort (iterative rather than recursive) by Cornel Huth
''
SUB sortQuickItr (array() AS INTEGER)
	DIM lstack(0 TO 255) AS INTEGER, stkRef AS INTEGER
	DIM midRef AS INTEGER
	DIM hi AS INTEGER, hi2 AS INTEGER
	DIM lo AS INTEGER, lo2 AS INTEGER

	lstack(0) = LBOUND(array)
	lstack(1) = UBOUND(array)
	stkRef = 2
	DO
		stkRef = stkRef - 2
		lo = lstack(stkRef)
		hi = lstack(stkRef + 1)
		DO
			lo2 = lo: hi2 = hi
			midRef = array((lo + hi) \ 2)
			DO
				DO WHILE (array(lo2) < midRef)
					lo2 = lo2 + 1
				LOOP
				DO WHILE (array(hi2) > midRef)
					hi2 = hi2 - 1
				LOOP
				IF (lo2 <= hi2) THEN
					SWAP array(lo2), array(hi2)
					lo2 = lo2 + 1
					hi2 = hi2 - 1
				END IF
			LOOP WHILE (lo2 <= hi2)

			IF (hi2 - lo) < (hi - lo2) THEN
				IF (lo2 < hi) THEN
					lstack(stkRef) = lo2
					lstack(stkRef + 1) = hi
					stkRef = stkRef + 2
				END IF
				hi = hi2
			ELSE
				IF (lo < hi2) THEN
					lstack(stkRef) = lo
					lstack(stkRef + 1) = hi2
					stkRef = stkRef + 2
				END IF
				lo = lo2
			END IF
		LOOP WHILE (lo < hi)
	LOOP WHILE stkRef
END SUB

''
'' Quick Sort (recursive) by Steve Gomez
''
SUB sortQuickRec (array() AS INTEGER, lf AS INTEGER, rt AS INTEGER)
	DIM NewLeft AS INTEGER, NewRight AS INTEGER, center AS INTEGER
	DIM CtrVal AS INTEGER

	IF (lf >= rt) THEN EXIT SUB

	center = (lf + rt) \ 2
	CtrVal = array(center)

	SWAP array(rt), array(center)
	NewLeft = lf
	NewRight = rt

	DO
		DO WHILE NewLeft < NewRight AND array(NewLeft) <= CtrVal
			NewLeft = NewLeft + 1
		LOOP

		DO WHILE NewRight > NewLeft AND array(NewRight) >= CtrVal
			NewRight = NewRight - 1
		LOOP

		IF NewLeft < NewRight THEN
			SWAP array(NewLeft), array(NewRight)
		END IF
	LOOP WHILE (NewLeft < NewRight)

	SWAP array(NewLeft), array(rt)

	IF (NewLeft - lf) < (rt - NewLeft) THEN
		sortQuickRec array(), lf, NewLeft - 1
		sortQuickRec array(), NewLeft + 1, rt
	ELSE
		sortQuickRec array(), NewLeft + 1, rt
		sortQuickRec array(), lf, NewLeft - 1
	END IF
END SUB

''
'' Shell Sort
''
SUB sortShell (array() AS INTEGER)
	DIM count AS INTEGER, offset AS INTEGER, max AS INTEGER
	DIM hiRef AS INTEGER

	count = UBOUND(array) - LBOUND(array) + 1
	offset = count \ 2
	DO WHILE offset
		max = count - offset - 1
		DO
			hiRef = 0
			FOR i% = 0 TO max
				IF array(i%) > array(i% + offset) THEN
					SWAP array(i%), array(i% + offset)
					hiRef = i%
				END IF
			NEXT i%
			max = hiRef - offset
		LOOP WHILE hiRef
		offset = offset \ 2
	LOOP
END SUB

''
'' Top Down Sort
''
SUB sortTopDown (array() AS INTEGER)
	DIM refSrc AS INTEGER, refDst AS INTEGER

	FOR i% = 0 TO UBOUND(array) - 1
		refSrc = array(i%)
		refDst = 0
		FOR j% = i% TO UBOUND(array)
			IF (array(j%) < refSrc) THEN
				refDst = j%
				refSrc = array(j%)
			END IF
		NEXT j%
		IF (refDst) THEN SWAP array(i%), array(refDst)
	NEXT i%
END SUB