home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib37b.dsk / VISISORT.bas < prev    next >
BASIC Source File  |  2023-02-26  |  9KB  |  179 lines

  1. 1  REM   ******************************
  2. 2  REM   * VISISORT                   *
  3. 3  REM   * BY Bill Fortenberry        *
  4. 4  REM   * COPYRIGHT(C) 1989          *
  5. 5  REM   * MINDCRAFT PUBL. CORP.      *
  6. 6  REM   * CONCORD, MA. 01742         *
  7. 7  REM   ******************************
  8. 10  LOMEM: 16384: PRINT  CHR$(21)
  9. 20  REM * N = NUMBER TO SORT *
  10. 30 N = 75
  11. 40 TV = 1
  12. 50  HCOLOR= 3: DIM A%(150),B%(150),L%(100),F%(100)
  13. 60  GOSUB 500
  14. 70  REM MENU
  15. 80  TEXT : HOME :P$ = "VISISORT BY BILL FORTENBERRY": GOSUB 650: PRINT : PRINT "COPYRIGHT(C) 1989 MINDCRAFT PUBL. CORP."
  16. 90  HTAB 1: VTAB 5: PRINT "PLEASE SELECT BY NUMBER:": PRINT : PRINT "1. BUBBLE SORT": PRINT "2. BI-BUBBLE SORT": PRINT "3. INTERCHANGE SORT": PRINT "4. SHELL - METZNER SORT": PRINT "5. QUICK SORT"
  17. 100  PRINT "6. GENERATE NEW ARRAY TO SORT": PRINT "7. RESET ARRAY SIZE"
  18. 110  PRINT "8. TRACK VARIABLES  ";: IF TV  THEN  INVERSE : PRINT " ON ": NORMAL 
  19. 120  IF   NOT TV  THEN  PRINT "OFF "
  20. 130  PRINT "9. QUIT"
  21. 140  HTAB 1: VTAB 20: PRINT "YOUR CHOICE (1-9) =-> "; CHR$(8);: GET IP$:IP =  VAL(IP$): IF IP <1  OR IP >9  THEN 140
  22. 150  REM 
  23. 160  IF IP = 9  THEN  TEXT : HOME : END 
  24. 170  IF IP = 7  THEN  GOSUB 330: GOTO 80
  25. 180  IF IP = 6  THEN  GOSUB 380: GOTO 80
  26. 190  IF IP = 8  AND TV = 1  THEN TV = 0: GOTO 90
  27. 200  IF IP = 8  AND TV = 0  THEN TV = 1: GOTO 90
  28. 210  REM SORT ARRAY
  29. 220  GOSUB 550:C = 0:X = 0: PRINT  CHR$(7): ON IP GOSUB 670,760,1030,1150,1310: VTAB 1: PRINT  CHR$(7): HOME : POKE 33,40: GOSUB 1720
  30. 230  REM SORT DATA PAGE
  31. 240  TEXT : HOME : INVERSE :P$ = "-VISISORT-": GOSUB 650:P$ = "SORT  DATA": GOSUB 650: NORMAL 
  32. 250  VTAB 8: PRINT "TYPE OF SORT : ";: IF IP = 1  THEN  PRINT "BUBBLE SORT"
  33. 260  IF IP = 2  THEN  PRINT "BI-BUBBLE SORT"
  34. 270  IF IP = 3  THEN  PRINT "INTERCHANGE SORT"
  35. 280  IF IP = 4  THEN  PRINT "SHELL - METZNER SORT"
  36. 290  IF IP = 5  THEN  PRINT "QUICK SORT"
  37. 300  PRINT : PRINT "SIZE OF ARRAY = ";N: PRINT : PRINT "# OF COMPARISONS = ";C: PRINT : PRINT "# OF EXCHANGES = ";X
  38. 310  GOSUB 1720: GOTO 80
  39. 320  REM CHANGE ARRAY SIZE
  40. 330  HOME : PRINT "OLD ARRAY SIZE =";N: PRINT : INPUT "NEW SIZE (5-150) >";IP$
  41. 340  IF IP$ = ""  THEN 330
  42. 350 N1 =  VAL(IP$): IF N1 <5  OR N1 >150  THEN 330
  43. 360 N = N1: GOTO 500
  44. 370  REM STIR UP ARRAY
  45. 380  HOME : PRINT "HOW MUCH SHOULD THE ARRAY BE SCRAMBLED": PRINT "USE A NUMBER BETWEEN 0 AND 280."
  46. 390  PRINT : PRINT "OR INPUT A W FOR A 'WORST CASE' SORT.": PRINT : PRINT 
  47. 400  INPUT "(0=NONE, 280=A LOT, W=W.C.) =->";IP$
  48. 410  IF IP$ = ""  THEN 380
  49. 420  IF IP$ = "W"  THEN 1630
  50. 430 IP =  VAL(IP$): IF IP <0  OR IP >280  THEN 380
  51. 440  REM SET UP NEW ARRAY
  52. 450  HOME : VTAB 21:P$ = "GENERATING ARRAY": GOSUB 650: FOR I = 1 TO N:B%(I) = I: NEXT 
  53. 460  HGR : GOSUB 1540: FOR I = 1 TO N: HPLOT I +65,N +1 -B%(I): NEXT 
  54. 470  IF IP = 0  THEN  RETURN 
  55. 480  FOR I = 1 TO IP:T2 =  INT( RND(1) *N) +1:T1 =  INT( RND(1) *N) +1:T = B%(T1):B%(T1) = B%(T2):B%(T2) = T: HCOLOR= 0: HPLOT T1 +65,0 TO T1 +65,N: HCOLOR= 3: HPLOT T1 +65,N +1 -B%(T1)
  56. 490  HCOLOR= 0: HPLOT T2 +65,0 TO T2 +65,N: HCOLOR= 3: HPLOT T2 +65,N +1 -B%(T2): NEXT : FOR I = 1 TO 3000: NEXT : RETURN 
  57. 500  HOME : VTAB 21:P$ = "GENERATING ARRAY": GOSUB 650: FOR I = 1 TO N:B%(I) = I: NEXT 
  58. 510  HGR : GOSUB 1540: FOR I = 1 TO N: HPLOT I +65,N +1 -B%(I): NEXT 
  59. 520  FOR I = 1 TO N:T1 = B%(I):T2 =  INT( RND(1) *N) +1:B%(I) = B%(T2):B%(T2) = T1: HCOLOR= 0: HPLOT I +65,0 TO I +65,N: HCOLOR= 3: HPLOT I +65,N +1 -B%(I)
  60. 530  HCOLOR= 0: HPLOT T2 +65,0 TO T2 +65,N: HCOLOR= 3: HPLOT T2 +65,N +1 -B%(T2): NEXT : PRINT : PRINT "PRESS RETURN TO CONTINUE";: GET XX$: RETURN 
  61. 540  REM GET OLD ARRAY
  62. 550  HOME : VTAB 21:P$ = "GETTING ARRAY TO SORT": GOSUB 650: FOR I = 1 TO N:A%(I) = B%(I): NEXT 
  63. 560  HGR : GOSUB 1540: FOR I = 1 TO N: HPLOT I +65,N +1 -A%(I): NEXT 
  64. 570  HOME : VTAB 22: INVERSE : ON IP GOSUB 590,600,610,620,630: GOSUB 650: POKE 33,10: NORMAL 
  65. 580  RETURN 
  66. 590 P$ = " BUBBLE SORT ": RETURN 
  67. 600 P$ = " BI-BUBBLE SORT ": RETURN 
  68. 610 P$ = " INTERCHANGE SORT ": RETURN 
  69. 620 P$ = " SHELL SORT ": RETURN 
  70. 630 P$ = " QUICK SORT ": RETURN 
  71. 640  REM CENTER TEXT ON SCREEN
  72. 650  HTAB (40 - LEN(P$))/2: PRINT P$: RETURN 
  73. 660  REM BUBBLE SORT
  74. 670 S% = N -1: FOR I = 1 TO S%
  75. 680 L = N -I: IF TV  THEN  GOSUB 1590
  76. 690  FOR J = 1 TO L: IF  PEEK( -16384) >128  THEN  GOSUB 1660
  77. 700 C = C +1: IF A%(J) <A%(J +1)  THEN 740
  78. 710 T = A%(J):A%(J) = A%(J +1):A%(J +1) = T:X = X +1
  79. 720  HCOLOR= 0: HPLOT J +65,0 TO J +65,N: HCOLOR= 3: HPLOT J +65,N +1 -A%(J)
  80. 730  HCOLOR= 0: HPLOT J +66,0 TO J +66,N: HCOLOR= 3: HPLOT J +66,N +1 -A%(J +1)
  81. 740  NEXT : NEXT : RETURN 
  82. 750  REM BI BUBBLE SORT
  83. 760 TP = N:BT = 1: IF TV  THEN  GOSUB 1600: GOSUB 1610
  84. 770 TP = TP -1: IF TV  THEN  GOSUB 1600
  85. 780 FG = 0
  86. 790  IF BT > = TP  THEN TP = TP +1
  87. 800  IF TV  THEN  GOSUB 1600
  88. 810  FOR I = BT TO TP: IF  PEEK( -16384) >128  THEN  GOSUB 1660
  89. 820 C = C +1: IF A%(I) <A%(I +1)  THEN 870
  90. 830 T = A%(I):A%(I) = A%(I +1):A%(I +1) = T:X = X +1
  91. 840 FG = 1
  92. 850  HCOLOR= 0: HPLOT I +66,0 TO I +66,N: HCOLOR= 3: HPLOT I +66,N +1 -A%(I +1)
  93. 860  HCOLOR= 0: HPLOT I +65,0 TO I +65,N: HCOLOR= 3: HPLOT I +65,N +1 -A%(I)
  94. 870  NEXT 
  95. 880  IF FG = 0  THEN  RETURN 
  96. 890 BT = BT +1: IF TV  THEN  GOSUB 1610
  97. 900 FG = 0: IF BT > = TP  THEN BT = BT -1
  98. 910  IF TV  THEN  GOSUB 1610
  99. 920  FOR I = TP TO BT  STEP  -1
  100. 930  IF  PEEK( -16384) >128  THEN  GOSUB 1660
  101. 940 C = C +1: IF A%(I) >A%(I -1)  THEN 990
  102. 950 X = X +1:T = A%(I):A%(I) = A%(I -1):A%(I -1) = T
  103. 960 FG = 1
  104. 970  HCOLOR= 0: HPLOT I +64,0 TO I +64,N: HCOLOR= 3: HPLOT I +64,N +1 -A%(I -1)
  105. 980  HCOLOR= 0: HPLOT I +65,0 TO I +65,N: HCOLOR= 3: HPLOT I +65,N +1 -A%(I)
  106. 990  NEXT 
  107. 1000  IF FG = 0  THEN  RETURN 
  108. 1010  GOTO 770
  109. 1020  REM INTERCHANGE SORT
  110. 1030 N1 = N -1: FOR J = 1 TO N1: IF TV  THEN  GOSUB 1580
  111. 1040 K = J:L = K +1
  112. 1050  FOR I = L TO N: IF TV  THEN  GOSUB 1570
  113. 1060  IF  PEEK( -16384) >128  THEN  GOSUB 1660
  114. 1070 C = C +1: IF A%(K) <A%(I)  THEN 1090
  115. 1080 K = I
  116. 1090  NEXT I
  117. 1100 T = A%(J):A%(J) = A%(K):A%(K) = T:X = X +1
  118. 1110  HCOLOR= 0: HPLOT J +65,0 TO J +65,N: HCOLOR= 3: HPLOT J +65,N +1 -A%(J)
  119. 1120  HCOLOR= 0: HPLOT K +65,0 TO K +65,N: HCOLOR= 3: HPLOT K +65,N +1 -A%(K)
  120. 1130  NEXT J: RETURN 
  121. 1140  REM SHELL - METZNER SORT
  122. 1150 M = N
  123. 1160 M =  INT(M/2): IF M = 0  THEN  RETURN 
  124. 1170 S% = N -M
  125. 1180 F% = 1
  126. 1190 J = F%
  127. 1200 I = J +M
  128. 1210  IF TV  THEN  GOSUB 1570: GOSUB 1580
  129. 1220  IF  PEEK( -16384) >128  THEN  GOSUB 1660
  130. 1230 C = C +1: IF A%(J) < = A%(I)  THEN 1280
  131. 1240 T = A%(J):A%(J) = A%(I):A%(I) = T:X = X +1
  132. 1250  HCOLOR= 0: HPLOT J +65,0 TO J +65,N: HCOLOR= 3: HPLOT J +65,N +1 -A%(J)
  133. 1260  HCOLOR= 0: HPLOT I +65,0 TO I +65,N: HCOLOR= 3: HPLOT I +65,N +1 -A%(I)
  134. 1270 J = J -M: IF J > = 1  THEN 1200
  135. 1280 F% = F% +1: IF F% >S%  THEN 1160
  136. 1290  GOTO 1190
  137. 1300  REM QUICK SORT
  138. 1310 S% = 0:F% = 1:L% = N
  139. 1320 M = A%( INT((L% +F%)/2)):I = F%:J = L%: IF TV  THEN  GOSUB 1560: GOSUB 1570: GOSUB 1580
  140. 1330  IF  PEEK( -16384) >128  THEN  GOSUB 1660
  141. 1340 C = C +1: IF A%(I) > = M  THEN 1370
  142. 1350 I = I +1: IF TV  THEN  GOSUB 1570
  143. 1360  GOTO 1340
  144. 1370 C = C +1: IF A%(J) < = M  THEN 1400
  145. 1380 J = J -1: IF TV  THEN  GOSUB 1580
  146. 1390  GOTO 1370
  147. 1400 C = C +1: IF I >J  THEN 1480
  148. 1410 C = C +1: IF I = J  THEN 1460
  149. 1420 T = A%(I):A%(I) = A%(J):A%(J) = T:X = X +1
  150. 1430  HCOLOR= 0: HPLOT I +65,0 TO I +65,N: HCOLOR= 3: HPLOT I +65,N +1 -A%(I)
  151. 1440  HCOLOR= 0: HPLOT J +65,0 TO J +65,N: HCOLOR= 3: HPLOT J +65,N +1 -A%(J)
  152. 1450  IF  PEEK( -16384) >128  THEN  GOSUB 1660
  153. 1460 I = I +1:J = J -1: IF TV  THEN  GOSUB 1570: GOSUB 1580
  154. 1470  IF I < = J  THEN 1340
  155. 1480  IF I > = L%  THEN 1500
  156. 1490 F%(S%) = I:L%(S%) = L%:S% = S% +1: IF LS% <S%  THEN LS% = S%
  157. 1500 L% = J: IF F% <L%  THEN 1320
  158. 1510  IF S% = 0  THEN  RETURN 
  159. 1520 S% = S% -1:F% = F%(S%):L% = L%(S%): GOTO 1320
  160. 1530  REM PLOT GRAPH AXIS
  161. 1540  HCOLOR= 3: HPLOT 60,0 TO 60,N +5 TO N +65,N +5: RETURN 
  162. 1550  REM PLOT SORT VARIABLES
  163. 1560  VTAB 21: PRINT "M="M"   ": HCOLOR= 0: HPLOT OM +65,N +7 TO OM +65,N +14: HCOLOR= 3: HPLOT M +65,N +7 TO M +65,N +14:OM = M: RETURN 
  164. 1570  VTAB 22: PRINT "I="I"   ": HCOLOR= 0: HPLOT OI +65,N +7 TO OI +65,N +10: HCOLOR= 3: HPLOT I +65,N +7 TO I +65,N +10:OI = I: RETURN 
  165. 1580  VTAB 23: PRINT "J="J"   ": HCOLOR= 0: HPLOT OJ +65,N +7 TO OJ +65,N +10: HCOLOR= 3: HPLOT J +65,N +7 TO J +65,N +10:OJ = J: RETURN 
  166. 1590  VTAB 22: PRINT "L="L"   ": HCOLOR= 0: HPLOT OL +65,N +7 TO OL +65,N +10: HCOLOR= 3: HPLOT L +65,N +7 TO L +65,N +10:OL = L: RETURN 
  167. 1600  VTAB 22: PRINT "TP="TP"   ": HCOLOR= 0: HPLOT OT +65,N +7 TO OT +65,N +10: HCOLOR= 3: HPLOT TP +65,N +7 TO TP +65,N +10:OT = TP: RETURN 
  168. 1610  VTAB 23: PRINT "BT="BT"   ": HCOLOR= 0: HPLOT OB +65,N +7 TO OB +65,N +10: HCOLOR= 3: HPLOT BT +65,N +7 TO BT +65,N +10:OB = BT: RETURN 
  169. 1620  REM  MAKE WORST CASE ARRAY
  170. 1630  HOME : VTAB 21:P$ = "GENERATING ARRAY": GOSUB 650: FOR I = 1 TO N:B%(I) = N +1 -I: NEXT 
  171. 1640  HGR : GOSUB 1540: FOR I = 1 TO N: HPLOT I +65,N +1 -B%(I): NEXT : RETURN 
  172. 1650  REM KEYPRESS PAUSE
  173. 1660  GOSUB 1710: POKE  -16368,0: FOR Q = 1 TO 250: IF  PEEK( -16384) >128  THEN Q = 251
  174. 1670  NEXT 
  175. 1680  IF  PEEK( -16384) <128  THEN 1660
  176. 1690  IF  PEEK( -16384) = 209  THEN  POKE  -16368,0: POP : GOTO 80
  177. 1700  POKE  -16368,0: RETURN 
  178. 1710  FOR QQ = 1 TO 5:S =  PEEK( -16336): NEXT : RETURN 
  179. 1720  VTAB 22: PRINT " PRESS RETURN TO CONTINUE";: GET A$: RETURN