Category : BASIC Source Code
Archive   : QB_QSORT.ZIP
Filename : QSORT.BAS

 
Output of file : QSORT.BAS contained in archive : QB_QSORT.ZIP
' QSORT quicksort sub program for QUICKBASIC, by William Nolan 70076,1463

' sample program to illustrate quicksort sub program
' This will sort a thousand records in less than 5 seconds.
' I make no effort to tell you how a quicksort works. If you are
' interested, get a good book on computer sorting algorithms.

' This sort will sort string arrays of either one or two dimensions.
' It could be easily modified to handle numbers or more than two dimensions.

CLS

' The calling program should dimension STACK, which is used by the sort,
' and two dummy arrays, one with 1 dimension, and 1 with 2.
' In addition, dimension the array or arrays you will want to sort.
' In this program, B$ is the array we are going to sort.

DIM STACK(50),B$(30,2),DUMMY1$(1),DUMMY2$(1,1)

' Read in test data

FOR X=1 TO 30
READ B$(X,1)
READ B$(X,2)
NEXT X

' Define variables for the number of dimensions (1 or 2), number of items
' in the array to be sorted, and the field to sort on. In the array B$,
' the second dimension is two, so SORTFIELD could have a value up to two.
' The routine will sort on any field in a two dimensional array.
' If NUMOFDIMENSIONS is one, SORTFIELD is ignored.

NUMOFDIMENSIONS=2
NUMOFITEMS=30
SORTFIELD=1

' The call must pass the array STACK, the two arrays to sort (one of which
' will always be a dummy), and the three variables defined above.
' If B$ was a 1 dimensional array, NUMOFDIMENSIONS would be defined as 1,
' and the routine would be called like this:
' CALL QSORT(STACK(),B$(),DUMMY2$(),NUMOFDIMENSIONS,NUMOFITEMS,SORTFIELD)

CALL QSORT(STACK(),DUMMY1$(),B$(),NUMOFDIMENSIONS,NUMOFITEMS,SORTFIELD)

' This routine can be compiled separately and put into a USERLIB.
' Remember, if you define variables as integers in the main program,
' they must be defined as integers before the SUB QSORT in the subroutine
' if it is in a separate program.

' Print out sorted sample data

FOR X=1 TO 30
PRINT B$(X,1),B$(X,2)
NEXT X

END

' Sample data to sort

DATA TOM,TUCSON,DICK,DETROIT,HARRY,PHOENIX,BOB,LA,STEVE,DENVER,JACK,AJO
DATA JIM,TUCSON,ANDY,PEORIA,ART,LA,BOB,PHOENIX,RON,DENVER,RICK,DETROIT
DATA PETE,PITTSBURG,PAUL,TUCSON,SAM,DETROIT,BOB,DENVER,FRANK,LA,JIM,LA
DATA MARY,TUCSON,SARA,LA,SARA,DETROIT,LINDA,PHOENIX,NANCY,DENVER,LU,LA
DATA RHONDA,TUCSON,MARY,DENVER,MARIA,NOGALES,LINDA,DENVER,SALLY,TUCSON
DATA PHYLLIS,PHOENIX

' Beginning of the actual sort subprogram.

SUB QSORT(STACK(1),SORT1$(1),SORT2$(2),NDIMS,NUMOFITEMS,SORTFIELD) STATIC


NEXTV=3:STACK(1)=1:STACK(2)=NUMOFITEMS

STARTSORT:

IF NEXTV=1 THEN GOTO ENDSORT ELSE THIS=STACK(NEXTV-2)
V9=STACK(NEXTV-2)+1:J9=STACK(NEXTV-1)
IF V9>J9 THEN NEXTV=NEXTV-2:GOTO STARTSORT

SORTPOINT1:

IF NDIMS=1 THEN
IF SORT1$(V9)>SORT1$(THIS) THEN GOTO SORTPOINT2
ELSEIF NDIMS>1 THEN
IF SORT2$(V9,SORTFIELD)>SORT2$(THIS,SORTFIELD) THEN GOTO SORTPOINT2
END IF

V9=V9+1:IF V9>J9 THEN GOTO SORTPOINT4 ELSE GOTO SORTPOINT1

SORTPOINT2:

IF NDIMS=1 THEN
IF SORT1$(J9) ELSEIF NDIMS>1 THEN
IF SORT2$(J9,SORTFIELD) END IF

J9=J9-1:IF V9>J9 THEN GOTO SORTPOINT4 ELSE GOTO SORTPOINT2

SORTPOINT3:

IF NDIMS=1 THEN
SWAP SORT1$(V9),SORT1$(J9)
ELSEIF NDIMS>1 THEN
FOR SWAPCOUNT=1 TO NDIMS
SWAP SORT2$(V9,SWAPCOUNT),SORT2$(J9,SWAPCOUNT)
NEXT SWAPCOUNT
END IF

V9=V9+1:J9=J9-1:IF V9>J9 THEN GOTO SORTPOINT4 ELSE GOTO SORTPOINT1

SORTPOINT4:

IF J9 IF V9>STACK(NEXTV-1) THEN V9=STACK(NEXTV-1)
SWAP V9,J9
IF NDIMS=1 THEN
SWAP SORT1$(THIS),SORT1$(V9)
ELSEIF NDIMS>1 THEN
FOR SWAPCOUNT=1 TO NDIMS
SWAP SORT2$(THIS,SWAPCOUNT),SORT2$(V9,SWAPCOUNT)
NEXT SWAPCOUNT
END IF

K9=STACK(NEXTV-2)
L9=STACK(NEXTV-1)
NEXTV=NEXTV-2

IF V9-K9<=0 THEN IF L9-J9<=0 THEN GOTO STARTSORT_
ELSE STACK(NEXTV)=J9:STACK(NEXTV+1)=L9:NEXTV=NEXTV+2:GOTO STARTSORT

IF L9-J9<=0 THEN STACK(NEXTV)=K9:STACK(NEXTV+1)=V9-1:_
NEXTV=NEXTV+2:GOTO STARTSORT

IF V9-K9>L9-J9+1 THEN STACK(NEXTV)=K9:STACK(NEXTV+1)=V9-1:_
STACK(NEXTV+2)=J9:STACK(NEXTV+3)=L9:NEXTV=NEXTV+4:GOTO STARTSORT

STACK(NEXTV)=J9
STACK(NEXTV+1)=L9
STACK(NEXTV+2)=K9
STACK(NEXTV+3)=V9-1
NEXTV=NEXTV+4
GOTO STARTSORT

ENDSORT:

END SUB



  3 Responses to “Category : BASIC Source Code
Archive   : QB_QSORT.ZIP
Filename : QSORT.BAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/