home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / BAS_SORT.ZIP / QSORT.BAS < prev    next >
BASIC Source File  |  1980-01-01  |  4KB  |  149 lines
  1. ' QSORT quicksort sub program for QUICKBASIC, by William Nolan 70076,1463
  2.  
  3. ' sample program to illustrate quicksort sub program
  4. ' This will sort a thousand records in less than 5 seconds.
  5. ' I make no effort to tell you how a quicksort works.  If you are
  6. ' interested, get a good book on computer sorting algorithms.
  7.  
  8. ' This sort will sort string arrays of either one or two dimensions.
  9. ' It could be easily modified to handle numbers or more than two dimensions.
  10.  
  11. CLS
  12.  
  13. ' The calling program should dimension STACK, which is used by the sort,
  14. ' and two dummy arrays, one with 1 dimension, and 1 with 2.
  15. ' In addition, dimension the array or arrays you will want to sort.
  16. ' In this program, B$ is the array we are going to sort.
  17.  
  18. DIM STACK(50),B$(30,2),DUMMY1$(1),DUMMY2$(1,1)
  19.  
  20. ' Read in test data
  21.  
  22. FOR X=1 TO 30
  23.      READ B$(X,1)
  24.      READ B$(X,2)
  25. NEXT X
  26.  
  27. ' Define variables for the number of dimensions (1 or 2), number of items
  28. ' in the array to be sorted, and the field to sort on.  In the array B$,
  29. ' the second dimension is two, so SORTFIELD could have a value up to two.
  30. ' The routine will sort on any field in a two dimensional array.
  31. ' If NUMOFDIMENSIONS is one, SORTFIELD is ignored.
  32.  
  33. NUMOFDIMENSIONS=2
  34. NUMOFITEMS=30
  35. SORTFIELD=1
  36.  
  37. ' The call must pass the array STACK, the two arrays to sort (one of which
  38. ' will always be a dummy), and the three variables defined above.
  39. ' If B$ was a 1 dimensional array, NUMOFDIMENSIONS would be defined as 1,
  40. ' and the routine would be called like this:
  41. ' CALL QSORT(STACK(),B$(),DUMMY2$(),NUMOFDIMENSIONS,NUMOFITEMS,SORTFIELD)
  42.  
  43. CALL QSORT(STACK(),DUMMY1$(),B$(),NUMOFDIMENSIONS,NUMOFITEMS,SORTFIELD)
  44.  
  45. ' This routine can be compiled separately and put into a USERLIB.
  46. ' Remember, if you define variables as integers in the main program,
  47. ' they must be defined as integers before the SUB QSORT in the subroutine
  48. ' if it is in a separate program.
  49.  
  50. ' Print out sorted sample data
  51.  
  52. FOR X=1 TO 30
  53.      PRINT B$(X,1),B$(X,2)
  54. NEXT X
  55.  
  56. END
  57.  
  58. ' Sample data to sort
  59.  
  60. DATA TOM,TUCSON,DICK,DETROIT,HARRY,PHOENIX,BOB,LA,STEVE,DENVER,JACK,AJO
  61. DATA JIM,TUCSON,ANDY,PEORIA,ART,LA,BOB,PHOENIX,RON,DENVER,RICK,DETROIT
  62. DATA PETE,PITTSBURG,PAUL,TUCSON,SAM,DETROIT,BOB,DENVER,FRANK,LA,JIM,LA
  63. DATA MARY,TUCSON,SARA,LA,SARA,DETROIT,LINDA,PHOENIX,NANCY,DENVER,LU,LA
  64. DATA RHONDA,TUCSON,MARY,DENVER,MARIA,NOGALES,LINDA,DENVER,SALLY,TUCSON
  65. DATA PHYLLIS,PHOENIX
  66.  
  67. ' Beginning of the actual sort subprogram.
  68.  
  69. SUB QSORT(STACK(1),SORT1$(1),SORT2$(2),NDIMS,NUMOFITEMS,SORTFIELD) STATIC
  70.  
  71.  
  72. NEXTV=3:STACK(1)=1:STACK(2)=NUMOFITEMS
  73.  
  74. STARTSORT:
  75.  
  76. IF NEXTV=1 THEN GOTO ENDSORT ELSE THIS=STACK(NEXTV-2)
  77. V9=STACK(NEXTV-2)+1:J9=STACK(NEXTV-1)
  78. IF V9>J9 THEN NEXTV=NEXTV-2:GOTO STARTSORT
  79.  
  80. SORTPOINT1:
  81.  
  82. IF NDIMS=1 THEN
  83.      IF SORT1$(V9)>SORT1$(THIS) THEN GOTO SORTPOINT2
  84. ELSEIF NDIMS>1 THEN
  85.      IF SORT2$(V9,SORTFIELD)>SORT2$(THIS,SORTFIELD) THEN GOTO SORTPOINT2
  86. END IF
  87.  
  88. V9=V9+1:IF V9>J9 THEN GOTO SORTPOINT4 ELSE GOTO SORTPOINT1
  89.  
  90. SORTPOINT2:
  91.  
  92. IF NDIMS=1 THEN
  93.      IF SORT1$(J9)<SORT1$(THIS) THEN GOTO SORTPOINT3
  94. ELSEIF NDIMS>1 THEN
  95.      IF SORT2$(J9,SORTFIELD)<SORT2$(THIS,SORTFIELD) THEN GOTO SORTPOINT3
  96. END IF
  97.  
  98. J9=J9-1:IF V9>J9 THEN GOTO SORTPOINT4 ELSE GOTO SORTPOINT2
  99.  
  100. SORTPOINT3:
  101.  
  102. IF NDIMS=1 THEN
  103.      SWAP SORT1$(V9),SORT1$(J9)
  104. ELSEIF NDIMS>1 THEN
  105.      FOR SWAPCOUNT=1 TO NDIMS
  106.       SWAP SORT2$(V9,SWAPCOUNT),SORT2$(J9,SWAPCOUNT)
  107.      NEXT SWAPCOUNT
  108. END IF
  109.  
  110. V9=V9+1:J9=J9-1:IF V9>J9 THEN GOTO SORTPOINT4 ELSE GOTO SORTPOINT1
  111.  
  112. SORTPOINT4:
  113.  
  114. IF J9<STACK(NEXTV-2) THEN J9=STACK(NEXTV-2)
  115. IF V9>STACK(NEXTV-1) THEN V9=STACK(NEXTV-1)
  116. SWAP V9,J9
  117. IF NDIMS=1 THEN
  118.      SWAP SORT1$(THIS),SORT1$(V9)
  119. ELSEIF NDIMS>1 THEN
  120.      FOR SWAPCOUNT=1 TO NDIMS
  121.       SWAP SORT2$(THIS,SWAPCOUNT),SORT2$(V9,SWAPCOUNT)
  122.      NEXT SWAPCOUNT
  123. END IF
  124.  
  125. K9=STACK(NEXTV-2)
  126. L9=STACK(NEXTV-1)
  127. NEXTV=NEXTV-2
  128.  
  129. IF V9-K9<=0 THEN IF L9-J9<=0 THEN GOTO STARTSORT_
  130.       ELSE STACK(NEXTV)=J9:STACK(NEXTV+1)=L9:NEXTV=NEXTV+2:GOTO STARTSORT
  131.  
  132. IF L9-J9<=0 THEN STACK(NEXTV)=K9:STACK(NEXTV+1)=V9-1:_
  133.       NEXTV=NEXTV+2:GOTO STARTSORT
  134.  
  135. IF V9-K9>L9-J9+1 THEN STACK(NEXTV)=K9:STACK(NEXTV+1)=V9-1:_
  136.       STACK(NEXTV+2)=J9:STACK(NEXTV+3)=L9:NEXTV=NEXTV+4:GOTO STARTSORT
  137.  
  138. STACK(NEXTV)=J9
  139. STACK(NEXTV+1)=L9
  140. STACK(NEXTV+2)=K9
  141. STACK(NEXTV+3)=V9-1
  142. NEXTV=NEXTV+4
  143. GOTO STARTSORT
  144.  
  145. ENDSORT:
  146.  
  147. END SUB
  148.