Category : BASIC Source Code
Archive   : QB_QSORT.ZIP
Filename : QSORT.BAS
' 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)
IF SORT2$(J9,SORTFIELD)
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
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
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
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/