QBasic & Borland Pascal & C/Delphi5.iso/Basic/Q_BASIC.450/SORTDEMO.BAS

QuickBASIC Tokenized Source | 1989-08-07 | 21.2 KB | 353 lines

RandInt
lower
Upper
BoxInit0
BubbleSortY
CheckScreen+
@    DrawFrame
TopSideF
BottomSide
LeftSide
    RightSide
ElapsedTime
CurrentRow
ExchangeSort
HeapSort
Initialize8
InsertionSort
PercolateDown
MaxLevel`
PercolateUp~
PrintOneBarK
@    QuickSort
Reinitialize
@    ShellSort
SortMenu
SwapBarsm
ToggleSound'
Column
SortType
Length
ColorVal
    BarString
FALSE
LEFTCOLUMNT
NUMOPTIONS
NUMSORTS
    SortArray%
SortBackup
OptionTitle
    StartTime
Foreground
Background
NoSoundB
Pause
    Selection
MaxRow
InitRowU
    MaxColors
GetRow
MonoTrap/
RowTrap
Limit
Switch8
ULEFT
URIGHT
LLEFT
LRIGHT
VERTICAL
HORIZONTAL
FrameWidth
FORMAT
SmallestRow
    TempArray
MaxIndex
Index
    BarLength
TempVal
TempLength
Child
Parent
    RandIndex
    Partition
Offset
Escape
Option
Choice
Checffff
! SORTDEMO
 This program graphically demonstrates six common sorting algorithms.  It=
 prints 25 or 43 horizontal bars, all of different lengths and all in random
! 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.n
 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 followD
 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 noticeo
 a difference in their relative speeds (for example, the exchangen
 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.
 Default type integer.
 Declare FUNCTION and SUB procedures, and the number and type of arguments:=
 Define the data type used to hold the information for each colored bar:
 Bar length (the element comparedr
 in the different sorts)
 Bar color
 The bar (a string of 43 characters)
 Declare global constants:
 Declare global variables, and allocate storage space for them.  SortArray
 and SortBackup are both arrays of the data type SortType defined above:
 Data statements for the different options printed in the sort menu:
 Insertion, Bubble, Heap, Exchange, Shell, Quick,
 Toggle Sound, , <   (Slower), >   (Faster)
 Begin logic of module-level code:
 Initialize data values.
 Print sort menu.v
 Restore original number of rows.
 Restore default color
 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 currentr
 video adapter is monochrome.  RowTrap sets the maximum possible
 number of rows (43 or 25).e
RandInt
= RandInt%
   Returns a random integer greater than or equal to the Lower parameter
   and less than or equal to the Upper parameter.
BoxInit
= BoxInit
 Calls the DrawFrame procedure to draw the frame around the sort menu,
 then prints the different options stored in the OptionTitle array.n
QUICKBASIC SORTING DEMO"
 Don't print the last option (> Faster) if the length of the Pause
 is down to 1 clock tick:i
 Toggle sound on or off, then print the current value for NoSound:
Type first character of"
choice ( I B H E S Q T < > )
or ESC key to end program: "
BubbleSort
= 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.
 Two adjacent elements are out of order, so swap their values=
 and redraw those two bars:o
 Sort on next pass only to where the last switch was made:
CheckScreen
= CheckScreen
 Checks for type of monitor (VGA, EGA, CGA, or monochrome) and
 starting number of screen lines (50, 43, or 25).n
 Try locating to the 50th row; if that fails, try the 43rd. Finally,
 if that fails, the user was using 25-line mode:
 Try a SCREEN 1 statement to see if the current adapter has colorl
 graphics; if that causes an error, reset MaxColors to 2:a
 See if 43-line mode is accepted; if not, run this program in 25-line
 mode:
 Turn off error trapping.t
DrawFrame
= 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.n
ElapsedTime
= 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.a
  &###.### seconds
 Print current selection and number of seconds elapsed in=
 reverse video:s
 Sound off, so just pause.
 Sound on, so play a note whilee
 pausing.
 Restore regular foreground andl
 background colors.e
ExchangeSort
= ExchangeSort
   The ExchangeSort compares each element in SortArray - starting with
   the first element - with every following element.  If any of thei
   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.
 Found a row shorter than the current row, so swap those
 two array elements:
HeapSort
= 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:a
 SortArray(1)
 SortArray(2)
 SortArray(3)
     SortArray(4)   SortArray(5)   SortArray(6)  SortArray(7)e
 ...   ...
 ...   ...
 ...  ...
 ...S
  where each "parent node" is greater than each of its "child nodes"; fors
  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).T
  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.
Initialize
= Initialize
 Initializes the SortBackup and OptionTitle arrays.  It also calls the
 CheckScreen, BoxInit, and RandInt% procedures.a
 Check for monochrome or EGA and set
 maximum number of text lines.
 Seed the random-number generator.
 Call RandInt% to find a random element in TempArray between 1
 and MaxIndex, then assign the value in that element to BarLength:
 Overwrite the value in TempArray(Index) with the value in
 TempArray(MaxIndex) so the value in TempArray(Index) is
 chosen only once:
 Decrease the value of MaxIndex so that TempArray(MaxIndex) can't:
 be chosen on the next pass through the loop:r
 Assign the BarLength value to the .Length element, then store
 a string of BarLength block characters (ASCII 223:
) in thee
 .BarString element:
 Store the appropriate color value in the .ColorVal element:
 Read SORT DEMO menu options and store
 them in the OptionTitle array.s
 Assign values in SortBackup to SortArray and draw
 unsorted bars on the screen.a
 Initialize Pause to 2 clock ticks (@ 1/9 second).
 Draw frame for the sort menu and print options.
InsertionSort
= 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.
 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:l
 Print the new bar.
 Print the elapsed time.
 Otherwise, exit the FOR...NEXT loop:r
 Insert the original value of SortArray(Row) in SortArray(J):i
PercolateDown
= PercolateDown
   The PercolateDown procedure restores the elements of SortArray from 1 to=
   MaxLevel to a "heap" (see the diagram with the HeapSort procedure).
 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):
 Get the subscript for the child node.
 Reached the bottom of the heap, so exit this procedure:
 If there are two child nodes, find out which one is bigger:
 Move the value down if it is still not bigger than either one of
 its children:
 Otherwise, SortArray has been restored to a heap from 1 to MaxLevel,p
 so exit:e
PercolateUp
= PercolateUp
   The PercolateUp procedure converts the elements from 1 to MaxLevel in
   SortArray into a "heap" (see the diagram with the HeapSort procedure).
 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):=
 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:
 Otherwise, the element has reached its proper place in the heap,
 so exit this procedure:
PrintOneBar
= PrintOneBar
  Prints SortArray(Row).BarString at the row indicated by the Row
  parameter, using the color in SortArray(Row).ColorVal.
QuickSort
= 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 callede
   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.s
 Only two elements in this subdivision; swap them if they are out of
 order, then end recursive calls:i
 Pick a pivot element at random, then move it to the end:
 Move in from both sides towards the pivot element:e
 If we haven't reached the pivot element, it means that two
 elements on either side are out of order, so swap them:
 Move the pivot element back to its proper place in the array:
 Recursively call the QuickSort procedure (pass the smallera
 subdivision first to use less stack space):
Reinitialize
= Reinitialize
   Restores the array SortArray to its original unsorted state, then
   prints the unsorted color bars.
ShellSort
= ShellSort
  The ShellSort procedure is similar to the BubbleSort procedure.  However,=
  ShellSort begins by comparing elements that are far apart (separated byr
  the value of the Offset variable, which is initially half the distance
  between the first and last element), then comparing elements that aree
  closer together (when Offset is one, the last iteration of this procedure
  is merely a bubble sort).s
 Set comparison offset to half the number of records in SortArray:
 Loop until offset gets to zero.
 Assume no switches at this offset..
 Compare elements and switch ones out of order:c
 Sort on next pass only to where last switch was made:
 No switches at last offset, try one half as big:m
SortMenu
= SortMenu
   The SortMenu procedure first calls the Reinitialize procedure to make
   sure the SortArray is in its unsorted form, then prompts the user toe
   make one of the following choices:t
 * One of the sorting algorithms
 * Toggle sound on or offo
 * Increase or decrease speedh
 * End the program
 Create a string consisting of all legal choices:=
IBHESQ><T"
 Make the cursor visible:E
 Get the user's choice and see
 if it's one of the menu options.s
 User chose one of the sorting procedures:
 Rescramble the bars.i
 Make the cursor invisible.e
 Set reverse-video values.
 Record the starting time.
 Branch to the appropriate procedure depending on the key typed:
 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):
 Increase pause length to slow down sorting time, then redrawr
 the menu to clear any timing results (since they won't compare
 with future results):
 User pressed ESC, so exit this procedure and return to
 module level:
 Invalid key
 Turn off reverse video.
 Print final time.
SwapBars
= SwapBars
   Calls PrintOneBar twice to switch the two bars in Row1 and Row2,=
   then calls the ElapsedTime procedure.
ToggleSound
= ToggleSound
   Reverses the current value for NoSound, then prints that value next
   to the "Toggle Sound" option on the sort menu.r
: OFF"
: ON "