home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / BAS_SORT.ZIP / CSORT.BAS < prev    next >
BASIC Source File  |  1989-07-11  |  2KB  |  97 lines
  1. 10 'program: Seesort
  2. 20 ' by John P. Grillo and J.D. Robertson
  3. 30 ' Bentley College, Waltham, MA, 02154'
  4. 40 ' from _More Color Computer Applications: High Resolution Graphics_'
  5. 50 '  (New York, John Wiley & Sons, 1984)'
  6. 60 DEFINT A-Z
  7. 70 DIM X(390)
  8. 80 CLS: KEY OFF:SCREEN 2
  9. 90 PRINT TAB(10); "Select"
  10. 100 PRINT TAB(12); "sort
  11. 110 PRINT TAB(8); "technique"
  12. 120 PRINT TAB(50);"1 -- Exchange sort"
  13. 130 PRINT TAB(50);"2 -- Delayed exchange sort"
  14. 140 PRINT TAB(50);"3 -- Shell-Metzner sort"
  15. 150 PRINT TAB(50);"4 -- Shell sort"
  16. 160 PRINT TAB(50);"5 -- Insertion sort"
  17. 170 PRINT TAB(50);"6 -- End this program"
  18. 180 PRINT:PRINT TAB(40); "Which sort";
  19. 190 INPUT K
  20. 200 IF K = 6 THEN SCREEN 0,0,0:CLS:PRINT:PRINT "Program Terminated":END
  21. 210 PRINT TAB(40);"How many elements <390";
  22. 220 INPUT N
  23. 230 IF N>390 THEN 210
  24. 240 PRINT TAB(3); "What kind of data?"
  25. 250 INPUT " Random or worst case (R/W)"; D$
  26. 260 '
  27. 270 '
  28. 280 CLS
  29. 290 '
  30. 300 FOR I = 1 TO N
  31. 310 IF D$ = "W" OR D$ = "w" THEN X(I)=N+1-I ELSE X(I)=INT(RND*N+1)
  32. 320 PSET (I,X(I))
  33. 330 NEXT I
  34. 340 ON K GOSUB 450,520,610,740,850
  35. 350 X$ = INKEY$
  36. 360 IF X$ = " " THEN 350
  37. 370 IF X$ <> "/" THEN 80
  38. 380 CLS
  39. 390 STOP
  40. 400 ' **** Switch elements
  41. 410 T= X(I):PRESET(I,T):PSET(J,T)
  42. 420 X(I)=X(J): PRESET(J,X(J))
  43. 430 PSET(I,X(J)):X(J)=T
  44. 440 RETURN
  45. 450 ' **** Exchange sort
  46. 460 FOR I=1 TO N-1
  47. 470   FOR J=I+1 TO N
  48. 480     IF X(I) > X(J) THEN GOSUB 400
  49. 490   NEXT J
  50. 500 NEXT I
  51. 510 RETURN
  52. 520 ' **** Delayed exchange sort
  53. 530 FOR P=1 TO N-1
  54. 540   X=P
  55. 550   FOR K=P+1 TO N
  56. 560     IF X(K) < X(X) THEN X=K
  57. 570  NEXT K
  58. 580  IF P <> X THEN I=X: J=P: GOSUB 400
  59. 590 NEXT P
  60. 600 RETURN
  61. 610 ' ****  Shell-Metzner sort
  62. 620 P=N
  63. 630 P=P\2
  64. 640   IF P = 0 THEN RETURN
  65. 650 K=N-P: L=1
  66. 660 I=L
  67. 670 J=I+P
  68. 680   IF X(I) < X(J) THEN 710
  69. 690 GOSUB 400: I=I-P
  70. 700    IF I>= 1 THEN 670
  71. 710 L=L+1
  72. 720   IF L <= K THEN 660
  73. 730 GOTO 630
  74. 740 ' ****  Shell sort
  75. 750 P=N
  76. 760   IF P <= 1 THEN RETURN
  77. 770 P= P\2: M= N - P
  78. 780 F = 0
  79. 790 FOR J= 1 TO M
  80. 800   I = J + P
  81. 810     IF X(J) > X(I) THEN GOSUB 400: F = 1
  82. 820 NEXT J
  83. 830   IF F > 0 THEN 780
  84. 840 GOTO 760
  85. 850 ' **** Insertion sort
  86. 860 FOR P=1 TO N - 1
  87. 870   T = X(P + 1)
  88. 880   FOR J = P TO 1 STEP -1
  89. 890     IF T > X(J) THEN 930
  90. 900     X(J+1) = X(J): PSET(J+1,X(J+1)): PRESET(J,X(J+1))
  91. 910 NEXT J
  92. 920 J= 0
  93. 930  X(J+1) = T: PRESET (P+1,T):PSET(J+1,T)
  94. 940 NEXT P
  95. 950 RETURN
  96. 960 END
  97.