home *** CD-ROM | disk | FTP | other *** search
/ No Fragments Archive 10: Diskmags / nf_archive_10.iso / MAGS / ST_USER / 1989 / USER1189.MSA / LISTINGS.ARC / DEMOQUIK.BSC < prev    next >
Text File  |  1989-09-03  |  6KB  |  238 lines
  1. \ QUICKSORT DEMONSTRATION PROGRAM
  2. \ Written in FAST BASIC
  3. \ By Nigel Belcher
  4. \ Written for ST User June 1988
  5.  
  6. \ SAMPLE PROGRAM TO DEMONSTRATE THE SORTING MECHANISM USED
  7.  
  8. IF SCREENMODE=0 THEN stop=ALERT("[3][Cannot be|run in Low|Resolution][OK]",1):END
  9. yes=1
  10. no=0
  11. DIM array(20),sorted(20)
  12. HIDEMOUSE
  13. PROCfullscreen
  14. REPEAT
  15.     n=0
  16.     comparisons=0
  17.     swaps=0
  18.     PROCinputnumbers(n)
  19.     recursion=0
  20.     PROCquicksort(1,n)
  21.     PRINTTAB(40,8);"The list is now sorted"
  22.     PROCdisplaylist(1,n,n)
  23.     PRINTTAB(40,9);"Do you want to watch another sort?";
  24.     ok=-1
  25.     REPEAT
  26.         key$=GET$
  27.         IF key$="Y" OR key$="y" THEN another=yes
  28.         IF key$="N" OR key$="n" THEN another=no
  29.         UNTIL another=yes OR another=no
  30.     PRINTTAB(40,9);SPC(40);
  31.     PRINTTAB(40,8);SPC(20)
  32.     UNTIL another=no
  33. PROCrestorewindows
  34. SHOWMOUSE
  35. END
  36.  
  37.  
  38. DEFPROCinputnumbers(VAR n)
  39. LOCAL i,random,key$
  40. CLS
  41. REPEAT
  42.     INPUTTAB(0,1);"How many numbers do you want to sort (2 - 20)";n
  43.     PRINTTAB(0,1);SPC(159);
  44.     UNTIL n>=2 AND n<=20
  45. SHOWMOUSE
  46. random=ALERT("[1][Choice of numbers][Random|Your own]",1)
  47. HIDEMOUSE
  48. IF random=1 THEN
  49. \ Allocate random numbers
  50.     FOR i=1 TO n
  51.         array(i)=RND(1000)
  52.         sorted(i)=no
  53.         NEXT
  54.             ELSE
  55. \ Get user-input numbers
  56.     FOR i=1 TO n
  57.         REPEAT
  58.             PRINTTAB(0,i);SPC(70);
  59.             PRINTTAB(0,i);"Element no.";FORMAT$(i,"ZD");
  60.             INPUT array(i)
  61.             UNTIL array(i)=INT(array(i)) AND array(i)>=-99999 AND array(i)<=999999
  62.         sorted(i)=no
  63.         NEXT
  64.     ENDIF
  65. ENDPROC
  66.  
  67.  
  68.  
  69. DEFPROCfullscreen
  70. \ Various GEM routines to sort out window sizes
  71. RESERVE windowtitle%,80
  72. {windowtitle%}$="QUICKSORT DEMONSTRATION"
  73. SETWINDTITLE OUTHANDLE,windowtitle%
  74. GETWINDCOORDS OUTHANDLE,oldscreenxbase,oldscreenybase,oldscreenwidth,oldscreenheight
  75. GETWINDFULL OUTHANDLE,fullscreenxbase,fullscreenybase,fullscreenwidth,fullscreenheight
  76. SETWINDCOORDS OUTHANDLE,fullscreenxbase,fullscreenybase,fullscreenwidth,fullscreenheight
  77. CALCWORK %11111101111,fullscreenxbase,fullscreenybase,fullscreenwidth,fullscreenheight
  78. TXTRECT fullscreenxbase,fullscreenybase,fullscreenwidth,fullscreenheight
  79. CLS
  80. IF SCREENMODE=2 THEN normal=13 ELSE large=13:normal=6
  81. TXTSIZE normal
  82. ENDPROC
  83.  
  84.  
  85.  
  86. DEFPROCquicksort(first,last)
  87. \ The quicksort routine
  88. \ NOTE: It has been enhanced only by the need to display lists
  89. \       as the routine works
  90. LOCAL i,j,key
  91. recursion=recursion+1
  92. PROCdisplaylist(first,last,n)
  93. IF first>=last THEN sorted(last)=yes:ENDPROC
  94. \ Initial values of variables
  95. i=first
  96. PROCshowi
  97. j=last+1
  98. PROCshowj
  99. key=array(first)
  100. PRINTTAB(0,first);"key ->";
  101. REPEAT
  102.     REPEAT
  103. \ Move i down the list
  104.         i=i+1
  105.         comparisons=comparisons+1
  106.         PROCshowi
  107.         PROCdelay
  108.         UNTIL array(i)>=key OR i=last
  109.     REPEAT
  110. \ Move j up the list
  111.         j=j-1
  112.         comparisons=comparisons+1
  113.         PROCshowj
  114.         PROCdelay
  115.         UNTIL array(j)<=key OR j=first
  116.     IF i<j THEN
  117. \ i and j have stopped but not crossed over
  118.         PRINTTAB(40,6);"i and j haven't crossed over"
  119.         PRINTTAB(40,7);array(i);" (i) is bigger than ";key
  120.         PRINTTAB(40,8);array(j);" (j) is smaller than ";key
  121.         PRINTTAB(40,9);"These 2 numbers are swapped"
  122.         PROCswapnumbers(i,j)
  123.         PRINTTAB(40,6);SPC(38);
  124.         PRINTTAB(40,7);SPC(38);
  125.         PRINTTAB(40,8);SPC(38);
  126.         PRINTTAB(40,9);SPC(38);
  127.         ENDIF
  128.     UNTIL i>=j
  129. \ i and j have crossed over
  130. PRINTTAB(40,6);"i and j have now crossed"
  131. IF i=j THEN PRINTTAB(40,6);"i and j are now the same"
  132. PRINTTAB(40,7);"j is the correct position for ";key
  133. PRINTTAB(40,8);key;" and ";array(j);" are swapped"
  134. PRINTTAB(40,9);"so that ";key;" is in the right place"
  135. PROCswapnumbers(first,j)
  136. PROCdelay
  137. PRINTTAB(40,6);SPC(38);
  138. PRINTTAB(40,7);SPC(38);
  139. PRINTTAB(40,8);SPC(38);
  140. PRINTTAB(40,9);SPC(38);
  141. sorted(j)=yes
  142. \ Sort first half of list
  143. PROCquicksort(first,j-1)
  144. recursion=recursion-1
  145. \ Sort second half of list
  146. PROCquicksort(j+1,last)
  147. recursion=recursion-1
  148. ENDPROC
  149.  
  150.  
  151.  
  152. DEFPROCdisplaylist(first,last,n)
  153. LOCAL i,key$,t,key
  154. FOR i=1 TO n
  155. \ Faint those not being looked at
  156.     IF i<first OR i>last THEN TXTEFFECTS %00000010 ELSE TXTEFFECTS 0
  157.     PRINTTAB(0,i);SPC(6);FORMAT$(array(i),"sZZZZZD");
  158.     IF sorted(i)=yes THEN PRINT" sorted";SPC(18); ELSE PRINT SPC(24);
  159.     NEXT
  160. TXTEFFECTS 0
  161. PRINTTAB(40,11);"Level of recursion ";FORMAT$(recursion,"ZD")
  162. ENDPROC
  163.  
  164.  
  165.  
  166. DEFPROCshowi
  167. PRINTTAB(29,i-1);"    ";
  168. PRINTTAB(29,i);"<- i";
  169. PRINTTAB(40,13);FORMAT$(comparisons,"<Comparisons    >ZZZZZD")
  170. ENDPROC
  171.  
  172.  
  173.  
  174. DEFPROCshowj
  175. PRINTTAB(33,j+1);"    ";
  176. PRINTTAB(33,j);"<- j";
  177. PRINTTAB(40,13);FORMAT$(comparisons,"<Comparisons    >ZZZZZD")
  178. ENDPROC
  179.  
  180.  
  181.  
  182. DEFPROCswapnumbers(a,b)
  183. LOCAL x,ya,yb,key,t
  184. IF a=b THEN ENDPROC
  185. swaps=swaps+1
  186. PRINTTAB(40,15);FORMAT$(swaps,"<Swaps          >ZZZZZD")
  187. IF a>b THEN SWAP a,b
  188. \ Move numbers out
  189. FOR x=0 TO 15
  190.     IF x<=7 THEN PRINTTAB(6+x,a);FORMAT$(array(a),"XsZZZZZD");
  191.     PRINTTAB(6+x,b);FORMAT$(array(b),"XsZZZZZD");
  192.     PROCdelay
  193.     NEXT
  194. ya=a:yb=b
  195. \ Move numbers up/down
  196. REPEAT
  197.     PRINTTAB(14,ya);SPC(7);
  198.     ya=ya+1
  199.     PRINTTAB(14,ya);FORMAT$(array(a),"sZZZZZD");
  200.     PROCdelay
  201.     PRINTTAB(22,yb);SPC(7);
  202.     yb=yb-1
  203.     PRINTTAB(22,yb);FORMAT$(array(b),"sZZZZZD");
  204.     PROCdelay
  205.     UNTIL yb<=a OR ya>=b
  206. SWAP array(a),array(b)
  207. \ Move numbers in
  208. FOR x=15 TO 0 STEP -1
  209.     PRINTTAB(6+x,a);FORMAT$(array(a),"sZZZZZDX");
  210.     IF x<=7 THEN PRINTTAB(6+x,b);FORMAT$(array(b),"sZZZZZDX");
  211.     PROCdelay
  212.     NEXT
  213. ENDPROC
  214.  
  215.  
  216.  
  217. DEFPROCdelay
  218. LOCAL t
  219. t=TIME
  220. REPEAT
  221.     UNTIL TIME-t>30
  222. ENDPROC
  223.  
  224.  
  225.  
  226. DEFPROCrestorewindows
  227. \ Restore output window to its original size
  228. GETWINDPREV OUTHANDLE,oldscreenxbase,oldscreenybase,oldscreenwidth,oldscreenheight
  229. CLS
  230. GRAB 0,0,oldscreenwidth,oldscreenheight
  231. CLOSEWIND OUTHANDLE
  232. PUT 0,0,3
  233. {windowtitle%}$="Output"
  234. SETWINDTITLE OUTHANDLE,windowtitle%
  235. OPENWIND OUTHANDLE,oldscreenxbase,oldscreenybase,oldscreenwidth,oldscreenheight
  236. ENDPROC
  237.  
  238.