paixu.txt

这是用QB编的排序程序。利用条形显示冒泡排序、快速排序、等五种排序方法。 效果一流

' ============================= InsertionSort ================================
'   The InsertionSort procedure compares the length of each successive
'   element in SortArray with the lengths of all the preceding elements.
'   When the procedure finds the appropriate place for the new element, it
'   inserts the element in its new place, and moves all the other elements
'   down one place.
' ============================================================================
'
SUB InsertionSort STATIC
   DIM TempVal AS SortType
   FOR Row = 2 TO MaxRow
      TempVal = SortArray(Row)
      TempLength = TempVal.Length
      FOR J = Row TO 2 STEP -1

         ' As long as the length of the J-1st element is greater than the
         ' length of the original element in SortArray(Row), keep shifting
         ' the array elements down:
         IF SortArray(J - 1).Length > TempLength THEN
            SortArray(J) = SortArray(J - 1)
            PrintOneBar J               ' Print the new bar.
            ElapsedTime J               ' Print the elapsed time.

         ' Otherwise, exit the FOR...NEXT loop:
         ELSE
            EXIT FOR
         END IF
      NEXT J

      ' Insert the original value of SortArray(Row) in SortArray(J):
      SortArray(J) = TempVal
      PrintOneBar J
      ElapsedTime J
   NEXT Row
END SUB

' ============================ PercolateDown =================================
'   The PercolateDown procedure restores the elements of SortArray from 1 to
'   MaxLevel to a "heap" (see the diagram with the HeapSort procedure).
' ============================================================================
'
SUB PercolateDown (MaxLevel) STATIC
   I = 1

   ' Move the value in SortArray(1) down the heap until it has
   ' reached its proper node (that is, until it is less than its parent
   ' node or until it has reached MaxLevel, the bottom of the current heap):
   DO
      Child = 2 * I             ' Get the subscript for the child node.

      ' Reached the bottom of the heap, so exit this procedure:
      IF Child > MaxLevel THEN EXIT DO

      ' If there are two child nodes, find out which one is bigger:
      IF Child + 1 <= MaxLevel THEN
         IF SortArray(Child + 1).Length > SortArray(Child).Length THEN
            Child = Child + 1
         END IF
      END IF

      ' Move the value down if it is still not bigger than either one of
      ' its children:
      IF SortArray(I).Length < SortArray(Child).Length THEN
         SWAP SortArray(I), SortArray(Child)
         SwapBars I, Child
         I = Child

      ' Otherwise, SortArray has been restored to a heap from 1 to MaxLevel,
      ' so exit:
      ELSE
         EXIT DO
      END IF
   LOOP
END SUB

' ============================== PercolateUp =================================
'   The PercolateUp procedure converts the elements from 1 to MaxLevel in
'   SortArray into a "heap" (see the diagram with the HeapSort procedure).
' ============================================================================
'
SUB PercolateUp (MaxLevel) STATIC
   I = MaxLevel

   ' Move the value in SortArray(MaxLevel) up the heap until it has
   ' reached its proper node (that is, until it is greater than either
   ' of its child nodes, or until it has reached 1, the top of the heap):
   DO UNTIL I = 1
      Parent = I \ 2            ' Get the subscript for the parent node.

      ' The value at the current node is still bigger than the value at
      ' its parent node, so swap these two array elements:
      IF SortArray(I).Length > SortArray(Parent).Length THEN
         SWAP SortArray(Parent), SortArray(I)
         SwapBars Parent, I
         I = Parent

      ' Otherwise, the element has reached its proper place in the heap,
      ' so exit this procedure:
      ELSE
         EXIT DO
      END IF
   LOOP
END SUB

' ============================== PrintOneBar =================================
'  Prints SortArray(Row).BarString at the row indicated by the Row
'  parameter, using the color in SortArray(Row).ColorVal.
' ============================================================================
'
SUB PrintOneBar (Row) STATIC
   LOCATE Row, 1
   COLOR SortArray(Row).ColorVal
   PRINT SortArray(Row).BarString;
END SUB

' ============================== QuickSort ===================================
'   QuickSort works by picking a random "pivot" element in SortArray, then
'   moving every element that is bigger to one side of the pivot, and every
'   element that is smaller to the other side.  QuickSort is then called
'   recursively with the two subdivisions created by the pivot.  Once the
'   number of elements in a subdivision reaches two, the recursive calls end
'   and the array is sorted.
' ============================================================================
'
SUB QuickSort (Low, High)
   IF Low < High THEN

      ' Only two elements in this subdivision; swap them if they are out of
      ' order, then end recursive calls:
      IF High - Low = 1 THEN
         IF SortArray(Low).Length > SortArray(High).Length THEN
            SWAP SortArray(Low), SortArray(High)
            SwapBars Low, High
         END IF
      ELSE

         ' Pick a pivot element at random, then move it to the end:
         RandIndex = RandInt%(Low, High)
         SWAP SortArray(High), SortArray(RandIndex)
         SwapBars High, RandIndex
         Partition = SortArray(High).Length
         DO

            ' Move in from both sides towards the pivot element:
            I = Low: J = High
            DO WHILE (I < J) AND (SortArray(I).Length <= Partition)
               I = I + 1
            LOOP
            DO WHILE (J > I) AND (SortArray(J).Length >= Partition)
               J = J - 1
            LOOP

            ' If we haven't reached the pivot element, it means that two
            ' elements on either side are out of order, so swap them:
            IF I < J THEN
               SWAP SortArray(I), SortArray(J)
               SwapBars I, J
            END IF
         LOOP WHILE I < J

         ' Move the pivot element back to its proper place in the array:
         SWAP SortArray(I), SortArray(High)
         SwapBars I, High

         ' Recursively call the QuickSort procedure (pass the smaller
         ' subdivision first to use less stack space):
         IF (I - Low) < (High - I) THEN
            QuickSort Low, I - 1
            QuickSort I + 1, High
         ELSE
            QuickSort I + 1, High
            QuickSort Low, I - 1
         END IF
      END IF
   END IF
END SUB

' =============================== RandInt% ===================================
'   Returns a random integer greater than or equal to the Lower parameter
'   and less than or equal to the Upper parameter.
' ============================================================================
'
FUNCTION RandInt% (lower, Upper) STATIC
   RandInt% = INT(RND * (Upper - lower + 1)) + lower
END FUNCTION

' ============================== Reinitialize ================================
'   Restores the array SortArray to its original unsorted state, then
'   prints the unsorted color bars.
' ============================================================================
'
SUB Reinitialize STATIC
   FOR I = 1 TO MaxRow
      SortArray(I) = SortBackup(I)
   NEXT I

   FOR I = 1 TO MaxRow
      LOCATE I, 1
      COLOR SortArray(I).ColorVal
      PRINT SortArray(I).BarString;
   NEXT I

   COLOR MaxColors, 0
END SUB

' =============================== ShellSort ==================================
'  The ShellSort procedure is similar to the BubbleSort procedure.  However,
'  ShellSort begins by comparing elements that are far apart (separated by
'  the value of the Offset variable, which is initially half the distance
'  between the first and last element), then comparing elements that are
'  closer together (when Offset is one, the last iteration of this procedure
'  is merely a bubble sort).
' ============================================================================
'
SUB ShellSort STATIC

   ' Set comparison offset to half the number of records in SortArray:
   Offset = MaxRow \ 2

   DO WHILE Offset > 0          ' Loop until offset gets to zero.
      Limit = MaxRow - Offset
      DO
         Switch = FALSE         ' Assume no switches at this offset.

         ' Compare elements and switch ones out of order:
         FOR Row = 1 TO Limit
            IF SortArray(Row).Length > SortArray(Row + Offset).Length THEN
               SWAP SortArray(Row), SortArray(Row + Offset)
               SwapBars Row, Row + Offset
               Switch = Row
            END IF
         NEXT Row

         ' Sort on next pass only to where last switch was made:
         Limit = Switch - Offset
      LOOP WHILE Switch

      ' No switches at last offset, try one half as big:
      Offset = Offset \ 2
   LOOP
END SUB

' =============================== SortMenu ===================================
'   The SortMenu procedure first calls the Reinitialize procedure to make
'   sure the SortArray is in its unsorted form, then prompts the user to
'   make one of the following choices:
'
'               * One of the sorting algorithms
'               * Toggle sound on or off
'               * Increase or decrease speed
'               * End the program
' ============================================================================
'
SUB SortMenu STATIC
   Escape$ = CHR$(27)

   ' Create a string consisting of all legal choices:
   Option$ = "IBHESQ><T" + Escape$

   DO

      ' Make the cursor visible:
      LOCATE NUMOPTIONS + 8, LEFTCOLUMN + 27, 1

      Choice$ = UCASE$(INPUT$(1))          ' Get the user's choice and see
      Selection = INSTR(Option$, Choice$)  ' if it's one of the menu options.

      ' User chose one of the sorting procedures:
      IF (Selection >= 1) AND (Selection <= NUMSORTS) THEN
         Reinitialize                      ' Rescramble the bars.
         LOCATE , , 0                      ' Make the cursor invisible.
         Foreground = 0                    ' Set reverse-video values.
         Background = 7
         StartTime = TIMER                 ' Record the starting time.
      END IF

      ' Branch to the appropriate procedure depending on the key typed:
      SELECT CASE Choice$
         CASE "I"
            InsertionSort
         CASE "B"
            BubbleSort
         CASE "H"
            HeapSort
         CASE "E"
            ExchangeSort
         CASE "S"
            ShellSort
         CASE "Q"
            QuickSort 1, MaxRow
         CASE ">"

            ' Decrease pause length to speed up sorting time, then redraw
            ' the menu to clear any timing results (since they won't compare
            ' with future results):
            Pause = (2 * Pause) / 3
            BoxInit

         CASE "<"

            ' Increase pause length to slow down sorting time, then redraw
            ' the menu to clear any timing results (since they won't compare
            ' with future results):
            Pause = (3 * Pause) / 2
            BoxInit

         CASE "T"
            ToggleSound 12, LEFTCOLUMN + 12

         CASE Escape$

            ' User pressed ESC, so exit this procedure and return to
            ' module level:
            EXIT DO

         CASE ELSE

            ' Invalid key
      END SELECT

      IF (Selection >= 1) AND (Selection <= NUMSORTS) THEN
         Foreground = MaxColors            ' Turn off reverse video.
         Background = 0
         ElapsedTime 0                     ' Print final time.
      END IF

   LOOP

END SUB

' =============================== SwapBars ===================================
'   Calls PrintOneBar twice to switch the two bars in Row1 and Row2,
'   then calls the ElapsedTime procedure.
' ============================================================================
'
SUB SwapBars (Row1, Row2) STATIC
   PrintOneBar Row1
   PrintOneBar Row2
   ElapsedTime Row1
END SUB

' ============================== ToggleSound =================================
'   Reverses the current value for NoSound, then prints that value next
'   to the "Toggle Sound" option on the sort menu.
' ============================================================================
'
SUB ToggleSound (Row, Column) STATIC
   NoSound = NOT NoSound
   LOCATE Row, Column
   IF NoSound THEN
      PRINT ": OFF";
   ELSE
      PRINT ": ON ";
   END IF
END SUB