home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / BAS_SORT.ZIP / CSORT.QB4 < prev    next >
Text File  |  1989-07-12  |  5KB  |  198 lines
  1.      ' program: Seesort
  2.      ' by John P. Grillo and J.D. Robertson
  3.      ' Bentley College, Waltham, MA, 02154'
  4.      ' from _More Color Computer Applications: High Resolution Graphics_'
  5.      '  (New York, John Wiley & Sons, 1984)'
  6.      '
  7.      ' Revision:  7-12-89 by Mike Welch of Dallas, TX
  8.      '            This simple revision put the source code in QuickBASIC
  9.      '            format in order to make the code more readable and
  10.      '            a bit more structured. 
  11.  
  12. DO                       ' begin the main loop of program   
  13.      DEFINT A-Z          ' Make integers the default
  14.      DIM X(390)
  15.     
  16.      CLS
  17.      SCREEN 2
  18.      PRINT TAB(10); "Select"
  19.      PRINT TAB(12); "sort"
  20.      PRINT TAB(8); "technique"
  21.      PRINT TAB(50); "1 -- Exchange sort"
  22.      PRINT TAB(50); "2 -- Delayed exchange sort"
  23.      PRINT TAB(50); "3 -- Shell-Metzner sort"
  24.      PRINT TAB(50); "4 -- Shell sort"
  25.      PRINT TAB(50); "5 -- Insertion sort"
  26.      PRINT TAB(50); "6 -- End this program"
  27.      PRINT
  28.      PRINT TAB(40); "Which sort";
  29.      INPUT K
  30.      IF K = 6 THEN  ' end the program
  31.          SCREEN 0, 0, 0
  32.          CLS
  33.          PRINT
  34.          PRINT "Program Terminated"
  35.          END
  36.      END IF
  37.     
  38.      DO
  39.           LOCATE 11
  40.           PRINT TAB(40); "How many elements < 390";
  41.           INPUT N
  42.           LOCATE 11
  43.           PRINT STRING$(78, " ")
  44.      LOOP WHILE N > 390
  45.      PRINT
  46.      PRINT N; "elements in sort"
  47.      PRINT
  48.      DO
  49.           LOCATE 15
  50.           PRINT STRING$(40, " ")
  51.           LOCATE 15
  52.           PRINT "What kind of data?"
  53.           INPUT "Random or worst case (R/W)"; d$
  54.           d$ = UCASE$(d$)          ' convert to uppercase   
  55.      LOOP UNTIL d$ = "R" OR d$ = "W"
  56.     
  57.      CLS
  58.     
  59.      FOR I = 1 TO N
  60.      IF d$ = "W" THEN
  61.          X(I) = N + 1 - I
  62.      ELSE
  63.           X(I) = INT(RND * N + 1)
  64.      END IF
  65.      PSET (I, X(I))
  66.      NEXT I
  67.      ON K GOSUB ExchgSort, DelExchgSort, ShellMet, ShellSort, Insertion
  68.      
  69. LOOP                ' loop indefinately
  70.  
  71.           '  _______________________________________________  '
  72.           ' |...............................................| '
  73.           ' |.... The following are gosubs--called from ....| '
  74.           ' |.... the main loop of the program. ............| '
  75.           ' |...............................................| '
  76.           ' |_______________________________________________| '
  77.  
  78. Switch:
  79.      ' *******************
  80.      ' * Switch elements *
  81.      ' *******************
  82.      T = X(I)
  83.      PRESET (I, T)
  84.      PSET (J, T)
  85.      X(I) = X(J)
  86.      PRESET (J, X(J))
  87.      PSET (I, X(J))
  88.      X(J) = T
  89.      RETURN
  90. ExchgSort:
  91.      ' ***********************
  92.      ' **** Exchange sort ****
  93.      ' ***********************
  94.      FOR I = 1 TO N - 1
  95.      FOR J = I + 1 TO N
  96.      IF X(I) > X(J) THEN
  97.          GOSUB Switch
  98.      END IF
  99.      NEXT J
  100.      NEXT I
  101.      RETURN
  102. DelExchgSort:
  103.      ' *******************************
  104.      ' **** Delayed exchange sort ****
  105.      ' *******************************
  106.      FOR P = 1 TO N - 1
  107.      X = P
  108.      FOR K = P + 1 TO N
  109.      IF X(K) < X(X) THEN
  110.          X = K
  111.      END IF
  112.      NEXT K
  113.      IF P <> X THEN
  114.          I = X
  115.          J = P
  116.          GOSUB Switch
  117.      END IF
  118.      NEXT P
  119.      RETURN
  120. ShellMet:
  121.      ' ****************************
  122.      ' **** Shell-Metzner sort ****
  123.      ' ****************************
  124.      P = N
  125. ShellM1:
  126.      P = P \ 2
  127.      IF P = 0 THEN
  128.          RETURN
  129.      END IF
  130.      K = N - P
  131.      L = 1
  132. ShellM2:
  133.      I = L
  134. ShellM3:
  135.      J = I + P
  136.      IF X(I) < X(J) THEN
  137.          GOTO ShellM4
  138.      END IF
  139.      GOSUB Switch
  140.      I = I - P
  141.      IF I >= 1 THEN
  142.          GOTO ShellM3
  143.      END IF
  144. ShellM4:
  145.      L = L + 1
  146.      IF L <= K THEN
  147.          GOTO ShellM2
  148.      END IF
  149.      GOTO ShellM1
  150. ShellSort:
  151.      ' ********************
  152.      ' **** SHELL sort ****
  153.      ' ********************
  154.      P = N
  155. Shell1:
  156.      IF P <= 1 THEN
  157.          RETURN
  158.      END IF
  159.      P = P \ 2
  160.      M = N - P
  161. Shell2:
  162.      F = 0
  163.      FOR J = 1 TO M
  164.      I = J + P
  165.      IF X(J) > X(I) THEN
  166.          GOSUB Switch
  167.          F = 1
  168.      END IF
  169.      NEXT J
  170.      IF F > 0 THEN
  171.          GOTO Shell2
  172.      END IF
  173.      GOTO Shell1
  174. Insertion:
  175.      ' ************************
  176.      ' **** Insertion sort ****
  177.      ' ************************
  178.      FOR P = 1 TO N - 1
  179.      T = X(P + 1)
  180.      FOR J = P TO 1 STEP -1
  181.      IF T > X(J) THEN
  182.          GOTO InserN1
  183.      END IF
  184.      X(J + 1) = X(J)
  185.      PSET (J + 1, X(J + 1))
  186.      PRESET (J, X(J + 1))
  187.      NEXT J
  188.      J = 0
  189. InserN1:
  190.      X(J + 1) = T
  191.      PRESET (P + 1, T)
  192.      PSET (J + 1, T)
  193.      NEXT P
  194.      RETURN
  195.     
  196.      END
  197.  
  198.