QBasic - sortation techniques

HomePage | Optical Illusions | War Stories | QBasic | Dads Navy Days | Bristol | Bristol, USA | Bristol, Canada | Terre Haute | Miscellany | Web Stuff | About Ray | Site Map | Site Search | Messages | Credits | Links | Web Rings

QBasic | Errors | 40lb Weight | Bits | Chance | Colours | Dates | Delays | File Dialog | Files | Input | Matching | Menus | Mouse | Numbers | SeqNo | SIRDS | Sorts | Text | Timer | DLoads

Sortation techniques :-

Being able to sort items by size is an important part of computing. It is also, perhaps one of the less easily understood routines. Some simple sort routines are very slow whilst others seem too arcane to be understood by mere mortals - or by me at least.

Whilst trawling through my back copies of PC Plus - one of the magazines I subscribe to, I found a very fast sortation method. The next day someone gave me a copy of a program called SortDemo which was lurking on the disks of one of our older machines. I have no idea who wrote it, or how we came to have a copy but I have included it in the downloadable zip file. It was investigating these routines that I made the logic error you can read about in Errors.

Here are the timings when I ran this program at home :-

Technique

Time
(Seconds)

Insertion

57

Bubble

51

Heap

24

Exchange

18

Shell

14

Quick

9

Quicksort :-

From the table you can see the quickest by far was the QuickSort routine. Here's a program that generates an array of random numbers then sorts them using a QuickSort algorithm.

Screenshot of QSort.bas

Screenshot of QSort.bas

'QSort  Ray Thomas      March 2002

'*** This is a QuickSort routine ***

DECLARE SUB DoSort (SortArray() AS INTEGER, Low AS INTEGER, High AS INTEGER)

'*** Program variables ***

OPTION BASE 1

DIM MyArray(250) AS INTEGER
DIM Count AS INTEGER            'Loop counter
DIM Number AS INTEGER           'General numeric variable

CLS

'*** Make an array of random numbers ***

PRINT
PRINT "Initial random array :-"
PRINT

RANDOMIZE TIMER
                                              
FOR Count = 1 TO UBOUND(MyArray)
        Number = (RND * 5000) + 1
        MyArray(Count) = Number
        PRINT MyArray(Count);
NEXT Count

Number = UBOUND(MyArray)

DoSort MyArray(), 1, Number

PRINT
PRINT
PRINT "Final sorted array :-"
PRINT
FOR Count = 1 TO UBOUND(MyArray)
        PRINT MyArray(Count);
NEXT Count

END

SUB DoSort (SortArray() AS INTEGER, Low AS INTEGER, High AS INTEGER)

DIM Lower AS INTEGER
DIM Higher AS INTEGER
DIM RandIndex AS INTEGER
DIM Partition AS INTEGER


'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.

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) > SortArray(High) THEN
                        SWAP SortArray(Low), SortArray(High)
                END IF

        ELSE

                '*** Pick a pivot element at random, then move it to the end ***

                RandIndex = INT(RND * (High - Low + 1)) + Low
                SWAP SortArray(High), SortArray(RandIndex)
                Partition = SortArray(High)
                DO

                        '*** Move in from both sides towards the pivot element ***

                        Lower = Low
                        Higher = High
                        DO WHILE (Lower < Higher) AND (SortArray(Lower) <= Partition)
                                Lower = Lower + 1
                        LOOP

                        DO WHILE (Higher > Lower) AND (SortArray(Higher) >= Partition)
                                Higher = Higher - 1
                        LOOP

                        '*** If pivot element not reached, it means that ***
                        '*** two elements on either side are out of order, ***
                        '*** so swap them ***

                        IF Lower < Higher THEN
                                SWAP SortArray(Lower), SortArray(Higher)
                        END IF

                LOOP WHILE Lower < Higher

                '*** Move the pivot element back to its proper place in the array ***

                SWAP SortArray(Lower), SortArray(High)

                '*** Recursively call the SortArray sub ***
                '*** Pass the smaller subdivision first to use less stack space ***

                IF (Lower - Low) < (High - Lower) THEN
                        DoSort SortArray(), Low, Lower - 1
                        DoSort SortArray(), Lower + 1, High
                ELSE
                        DoSort SortArray(), Lower + 1, High
                        DoSort SortArray(), Low, Lower - 1
                END IF
        END IF
END IF

END SUB

You can also sort a string array using this method. To do this you need to make all references to MyArray, SortArray and Partition into strings.

Bubblesort :-

One of the easiest sorts to write is the bubble sort. All this does is use two loops to compare every element of an array with every other element. If one element is bigger than the other it swaps them. for comparing short arrays it's good enough, but because of the number of comparisons it has to do, it's not really suitable for large arrays.

'BSort          Ray Thomas      April 2002

'A program to demonstrate a Bubblesort ***

OPTION BASE 1

DIM MyArray(50) AS INTEGER
DIM Number AS INTEGER
DIM Count AS INTEGER

'*** Make an array of random numbers ***

CLS
PRINT
PRINT "Initial random array :-"
PRINT

RANDOMIZE TIMER
                                             
FOR Count = 1 TO UBOUND(MyArray)
        Number = (RND * 5000) + 1
        MyArray(Count) = Number
        PRINT MyArray(Count);
NEXT Count

Number = UBOUND(MyArray)

'*** Do the Bubblesort ***

FOR Count = 1 TO Number
        FOR Counter = 1 TO Number
                IF MyArray(Counter) > MyArray(Count) THEN SWAP MyArray(Count), MyArray(Counter)
        NEXT Counter
NEXT Count

'*** Print the sorted array ***

PRINT
PRINT
PRINT "Bubble sorted array :-"
PRINT

FOR Count = 1 TO Number
        PRINT MyArray(Count);
NEXT Count

END

When you are writing and testing these sortation routines you'll need some test files to feed into the arrays. Here's a program that writes five of them. One is a file that is completely sorted, then sorted but "upsidedown", one with the largest numbers at the top, another with the smallest at the bottom and finally a completely random one. I originally wrote this program a couple of years ago, and surprisingly, it still works. Who says I only write WORM programs? In this case WORM stands for Works Once - Rewrites Many.

'MAKESORT.BAS   Ray Thomas      July 1999

'Program to make the sortation test files

OPTION BASE 1

DIM Count AS LONG               'Loop counter
DIM Counter AS LONG             'Loop counter
DIM Number AS LONG              'General numeric variable
DIM MaxNum AS LONG              'To hold the number of elements created
DIM FilePath AS STRING          'Path to the output files
DIM SwapNum AS LONG             'Number of small / large numbers to swap
DIM NumArray(30000) AS INTEGER  'To test for random numbers

'*** To alter the size of the file produced change the dimension for NumArray ***
'*** Alter FilePath$ below to change the file destinations

'*** Set the program variables ***

FilePath$ = "C:\brisray\"
MaxNum = UBOUND(NumArray)
SwapNum = MaxNum / 5

OPEN FilePath$ + "SORT1.TST" FOR OUTPUT ACCESS WRITE LOCK READ WRITE AS #1
OPEN FilePath$ + "SORT2.TST" FOR OUTPUT ACCESS WRITE LOCK READ WRITE AS #2
OPEN FilePath$ + "SORT3.TST" FOR OUTPUT ACCESS WRITE LOCK READ WRITE AS #3
OPEN FilePath$ + "SORT4.TST" FOR OUTPUT ACCESS WRITE LOCK READ WRITE AS #4
OPEN FilePath$ + "SORT5.TST" FOR OUTPUT ACCESS WRITE LOCK READ WRITE AS #5

'*** Make an array of completely sorted numbers ***

FOR Count = 1 TO MaxNum
        NumArray(Count) = Count
NEXT Count

CLS
RANDOMIZE TIMER
FOR Count = 1 TO MaxNum

        PRINT #5, Count
        LOCATE 2, 2
        PRINT "The loop counter is now"; Count
        PRINT

        Number = (RND * (MaxNum + 1 - Count)) + 1
       
        PRINT #1, NumArray(Number)
        PRINT "The random number generated is"; Number; "               "
        PRINT "from the NumArray this is"; NumArray(Number); "          "
        PRINT
       
        FOR Counter = Number TO MaxNum - Count
                NumArray(Counter) = NumArray(Counter + 1)
        NEXT Counter
   
        Number = MaxNum + 1 - Count          'Completely sorted - but backward
       
        PRINT #2, Number
        PRINT "The backward number is now"; Number
        PRINT

        IF Count < MaxNum - SwapNum THEN           'Nearly sorted - but small numbers at end
                Number = Count + SwapNum + 1
        ELSE Number = MaxNum + 1 - Count
        END IF
        PRINT #3, Number
        PRINT "The nearly sorted, but small numbers at end is now at"; Number; "         "
        PRINT

        IF Count < SwapNum + 1 THEN           'Nearly sorted - but large numbers at start
                Number = Count + MaxNum - SwapNum
        ELSE Number = Count - SwapNum
        END IF
        PRINT #4, Number
        PRINT "The nearly sorted, but large numbers at start is now at"; Number; "        "

NEXT Count
CLOSE
END

To make the program run properly you'll need to edit the FilePath$ variable to a directory on your own drive. You can also control how many lines are produced by changing the number of elements in the NumArray array.

The programs on this page, like all the programs written for this site, can be downloaded from the DLoads page.

QBasic | Errors | 40lb Weight | Bits | Chance | Colours | Dates | Delays | File Dialog | Files | Input | Matching | Menus | Mouse | Numbers | SeqNo | SIRDS | Sorts | Text | Timer | DLoads

HomePage | Optical Illusions | War Stories | QBasic | Dads Navy Days | Bristol | Bristol, USA | Bristol, Canada | Terre Haute | Miscellany | Web Stuff | About Ray | Site Map | Site Search | Messages | Credits | Links | Web Rings