paixu.txt

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

' ============================================================================
'                                 SORTDEMO
' This program graphically demonstrates six common sorting algorithms.  It
' prints 25 or 43 horizontal bars, all of different lengths and all in random
' order, then sorts the bars from smallest to longest.
'
' The program also uses SOUND statements to generate different pitches,
' depending on the location of the bar being printed. Note that the SOUND
' statements delay the speed of each sorting algorithm so you can follow
' the progress of the sort.  Therefore, the times shown are for comparison
' only. They are not an accurate measure of sort speed.
'
' If you use these sorting routines in your own programs, you may notice
' a difference in their relative speeds (for example, the exchange
' sort may be faster than the shell sort) depending on the number of
' elements to be sorted and how "scrambled" they are to begin with.
' ============================================================================

DEFINT A-Z      ' Default type integer.

' Declare FUNCTION and SUB procedures, and the number and type of arguments:
  DECLARE FUNCTION RandInt% (lower, Upper)

  DECLARE SUB BoxInit ()
  DECLARE SUB BubbleSort ()
  DECLARE SUB CheckScreen ()
  DECLARE SUB DrawFrame (TopSide, BottomSide, LeftSide, RightSide)
  DECLARE SUB ElapsedTime (CurrentRow)
  DECLARE SUB ExchangeSort ()
  DECLARE SUB HeapSort ()
  DECLARE SUB Initialize ()
  DECLARE SUB InsertionSort ()
  DECLARE SUB PercolateDown (MaxLevel)
  DECLARE SUB PercolateUp (MaxLevel)
  DECLARE SUB PrintOneBar (Row)
  DECLARE SUB QuickSort (Low, High)
  DECLARE SUB Reinitialize ()
  DECLARE SUB ShellSort ()
  DECLARE SUB SortMenu ()
  DECLARE SUB SwapBars (Row1, Row2)
  DECLARE SUB ToggleSound (Row, Column)

' Define the data type used to hold the information for each colored bar:
  TYPE SortType
     Length AS INTEGER         ' Bar length (the element compared
                               ' in the different sorts)
     ColorVal AS INTEGER       ' Bar color
     BarString AS STRING * 43  ' The bar (a string of 43 characters)
  END TYPE

' Declare global constants:
  CONST FALSE = 0, TRUE = NOT FALSE, LEFTCOLUMN = 49
  CONST NUMOPTIONS = 11, NUMSORTS = 6

' Declare global variables, and allocate storage space for them.  SortArray
' and SortBackup are both arrays of the data type SortType defined above:
  DIM SHARED SortArray(1 TO 43) AS SortType, SortBackup(1 TO 43) AS SortType
  DIM SHARED OptionTitle(1 TO NUMOPTIONS) AS STRING * 12
  DIM SHARED StartTime AS SINGLE
  DIM SHARED Foreground, Background, NoSound, Pause
  DIM SHARED Selection, MaxRow, InitRow, MaxColors

' Data statements for the different options printed in the sort menu:
  DATA Insertion, Bubble, Heap, Exchange, Shell, Quick,
  DATA Toggle Sound, , <   (Slower), >   (Faster)

' Begin logic of module-level code:

  Initialize             ' Initialize data values.
  SortMenu               ' Print sort menu.
  WIDTH 80, InitRow      ' Restore original number of rows.
  COLOR 7, 0             ' Restore default color    
  CLS
  END

' GetRow, MonoTrap, and RowTrap are error-handling routines invoked by
' the CheckScreen SUB procedure.  GetRow determines whether the program
' started with 25, 43, or 50 lines.  MonoTrap determines the current
' video adapter is monochrome.  RowTrap sets the maximum possible
' number of rows (43 or 25).

GetRow:
   IF InitRow = 50 THEN
      InitRow = 43
      RESUME
   ELSE
      InitRow = 25
      RESUME NEXT
   END IF

MonoTrap:
   MaxColors = 2
   RESUME NEXT

RowTrap:
   MaxRow = 25
   RESUME

' =============================== BoxInit ====================================
'    Calls the DrawFrame procedure to draw the frame around the sort menu,
'    then prints the different options stored in the OptionTitle array.
' ============================================================================
'
SUB BoxInit STATIC
   DrawFrame 1, 22, LEFTCOLUMN - 3, 78

   LOCATE 3, LEFTCOLUMN + 2: PRINT "QUICKBASIC SORTING DEMO";
   LOCATE 5
   FOR I = 1 TO NUMOPTIONS - 1
      LOCATE , LEFTCOLUMN: PRINT OptionTitle(I)
   NEXT I

   ' Don't print the last option (> Faster) if the length of the Pause
   ' is down to 1 clock tick:
   IF Pause > 1 THEN LOCATE , LEFTCOLUMN: PRINT OptionTitle(NUMOPTIONS);

   ' Toggle sound on or off, then print the current value for NoSound:
   NoSound = NOT NoSound
   ToggleSound 12, LEFTCOLUMN + 12

   LOCATE NUMOPTIONS + 6, LEFTCOLUMN
   PRINT "Type first character of"
   LOCATE , LEFTCOLUMN
   PRINT "choice ( I B H E S Q T < > )"
   LOCATE , LEFTCOLUMN
   PRINT "or ESC key to end program: ";
END SUB

' ============================== BubbleSort ==================================
'    The BubbleSort algorithm cycles through SortArray, comparing adjacent
'    elements and swapping pairs that are out of order.  It continues to
'    do this until no pairs are swapped.
' ============================================================================
'
SUB BubbleSort STATIC
   Limit = MaxRow
   DO
      Switch = FALSE
      FOR Row = 1 TO (Limit - 1)

         ' Two adjacent elements are out of order, so swap their values
         ' and redraw those two bars:
         IF SortArray(Row).Length > SortArray(Row + 1).Length THEN
            SWAP SortArray(Row), SortArray(Row + 1)
            SwapBars Row, Row + 1
            Switch = Row
         END IF
      NEXT Row

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

END SUB

' ============================== CheckScreen =================================
'     Checks for type of monitor (VGA, EGA, CGA, or monochrome) and
'     starting number of screen lines (50, 43, or 25).
' ============================================================================
'
SUB CheckScreen STATIC

   ' Try locating to the 50th row; if that fails, try the 43rd. Finally,
   ' if that fails, the user was using 25-line mode:
   InitRow = 50
   ON ERROR GOTO GetRow
   LOCATE InitRow, 1

   ' Try a SCREEN 1 statement to see if the current adapter has color
   ' graphics; if that causes an error, reset MaxColors to 2:
   MaxColors = 15
   ON ERROR GOTO MonoTrap
   SCREEN 1
   SCREEN 0

   ' See if 43-line mode is accepted; if not, run this program in 25-line
   ' mode:
   MaxRow = 43
   ON ERROR GOTO RowTrap
   WIDTH 80, MaxRow
   ON ERROR GOTO 0              ' Turn off error trapping.
END SUB

' ============================== DrawFrame ===================================
'   Draws a rectangular frame using the high-order ASCII characters ?(201) ,
'   ?(187) , ?(200) , ?(188) , ?(186) , and ?(205). The parameters
'   TopSide, BottomSide, LeftSide, and RightSide are the row and column
'   arguments for the upper-left and lower-right corners of the frame.
' ============================================================================
'
SUB DrawFrame (TopSide, BottomSide, LeftSide, RightSide) STATIC
   CONST ULEFT = 201, URIGHT = 187, LLEFT = 200, LRIGHT = 188
   CONST VERTICAL = 186, HORIZONTAL = 205

   FrameWidth = RightSide - LeftSide - 1
   LOCATE TopSide, LeftSide
   PRINT CHR$(ULEFT); STRING$(FrameWidth, HORIZONTAL); CHR$(URIGHT);
   FOR Row = TopSide + 1 TO BottomSide - 1
      LOCATE Row, LeftSide
      PRINT CHR$(VERTICAL); SPC(FrameWidth); CHR$(VERTICAL);
   NEXT Row
   LOCATE BottomSide, LeftSide
   PRINT CHR$(LLEFT); STRING$(FrameWidth, HORIZONTAL); CHR$(LRIGHT);
END SUB

' ============================= ElapsedTime ==================================
'    Prints seconds elapsed since the given sorting routine started.
'    Note that this time includes both the time it takes to redraw the
'    bars plus the pause while the SOUND statement plays a note, and
'    thus is not an accurate indication of sorting speed.
' ============================================================================
'
SUB ElapsedTime (CurrentRow) STATIC
   CONST FORMAT = "  &###.### seconds  "

   ' Print current selection and number of seconds elapsed in
   ' reverse video:
   COLOR Foreground, Background
   LOCATE Selection + 4, LEFTCOLUMN - 2
   PRINT USING FORMAT; OptionTitle(Selection); TIMER - StartTime;

   IF NoSound THEN
      SOUND 30000, Pause            ' Sound off, so just pause.
   ELSE
      SOUND 60 * CurrentRow, Pause  ' Sound on, so play a note while
   END IF                           ' pausing.

   COLOR MaxColors, 0               ' Restore regular foreground and
                                    ' background colors.
END SUB

' ============================= ExchangeSort =================================
'   The ExchangeSort compares each element in SortArray - starting with
'   the first element - with every following element.  If any of the
'   following elements is smaller than the current element, it is exchanged
'   with the current element and the process is repeated for the next
'   element in SortArray.
' ============================================================================
'
SUB ExchangeSort STATIC
   FOR Row = 1 TO MaxRow
      SmallestRow = Row
      FOR J = Row + 1 TO MaxRow
         IF SortArray(J).Length < SortArray(SmallestRow).Length THEN
            SmallestRow = J
            ElapsedTime J
         END IF
      NEXT J

      ' Found a row shorter than the current row, so swap those
      ' two array elements:
      IF SmallestRow > Row THEN
         SWAP SortArray(Row), SortArray(SmallestRow)
         SwapBars Row, SmallestRow
      END IF
   NEXT Row
END SUB

' =============================== HeapSort ===================================
'  The HeapSort procedure works by calling two other procedures - PercolateUp
'  and PercolateDown.  PercolateUp turns SortArray into a "heap," which has
'  the properties outlined in the diagram below:
'
'                               SortArray(1)
'                               /          \
'                    SortArray(2)           SortArray(3)
'                   /          \            /          \
'         SortArray(4)   SortArray(5)   SortArray(6)  SortArray(7)
'          /      \       /       \       /      \      /      \
'        ...      ...   ...       ...   ...      ...  ...      ...
'
'
'  where each "parent node" is greater than each of its "child nodes"; for
'  example, SortArray(1) is greater than SortArray(2) or SortArray(3),
'  SortArray(3) is greater than SortArray(6) or SortArray(7), and so forth.
'
'  Therefore, once the first FOR...NEXT loop in HeapSort is finished, the
'  largest element is in SortArray(1).
'
'  The second FOR...NEXT loop in HeapSort swaps the element in SortArray(1)
'  with the element in MaxRow, rebuilds the heap (with PercolateDown) for
'  MaxRow - 1, then swaps the element in SortArray(1) with the element in
'  MaxRow - 1, rebuilds the heap for MaxRow - 2, and continues in this way
'  until the array is sorted.
' ============================================================================
'
SUB HeapSort STATIC
   FOR I = 2 TO MaxRow
      PercolateUp I
   NEXT I

   FOR I = MaxRow TO 2 STEP -1
      SWAP SortArray(1), SortArray(I)
      SwapBars 1, I
      PercolateDown I - 1
   NEXT I
END SUB

' ============================== Initialize ==================================
'    Initializes the SortBackup and OptionTitle arrays.  It also calls the
'    CheckScreen, BoxInit, and RandInt% procedures.
' ============================================================================
'
SUB Initialize STATIC
   DIM TempArray(1 TO 43)

   CheckScreen                  ' Check for monochrome or EGA and set
                                ' maximum number of text lines.
   FOR I = 1 TO MaxRow
      TempArray(I) = I
   NEXT I

   MaxIndex = MaxRow

   RANDOMIZE TIMER              ' Seed the random-number generator.
   FOR I = 1 TO MaxRow

      ' Call RandInt% to find a random element in TempArray between 1
      ' and MaxIndex, then assign the value in that element to BarLength:
      Index = RandInt%(1, MaxIndex)
      BarLength = TempArray(Index)

      ' Overwrite the value in TempArray(Index) with the value in
      ' TempArray(MaxIndex) so the value in TempArray(Index) is
      ' chosen only once:
      TempArray(Index) = TempArray(MaxIndex)

      ' Decrease the value of MaxIndex so that TempArray(MaxIndex) can't
      ' be chosen on the next pass through the loop:
      MaxIndex = MaxIndex - 1

      ' Assign the BarLength value to the .Length element, then store
      ' a string of BarLength block characters (ASCII 223: ? in the
      ' .BarString element:
      SortBackup(I).Length = BarLength
      SortBackup(I).BarString = STRING$(BarLength, 223)

      ' Store the appropriate color value in the .ColorVal element:
      IF MaxColors > 2 THEN
         SortBackup(I).ColorVal = (BarLength MOD MaxColors) + 1
      ELSE
         SortBackup(I).ColorVal = MaxColors
      END IF
   NEXT I

   FOR I = 1 TO NUMOPTIONS      ' Read SORT DEMO menu options and store
      READ OptionTitle(I)       ' them in the OptionTitle array.
   NEXT I

   CLS
   Reinitialize         ' Assign values in SortBackup to SortArray and draw
                        ' unsorted bars on the screen.
   NoSound = FALSE
   Pause = 2            ' Initialize Pause to 2 clock ticks (@ 1/9 second).
   BoxInit              ' Draw frame for the sort menu and print options.

END SUB