Programming Tool Box

home *** CD-ROM | disk | FTP | other *** search

/ Programming Tool Box / SIMS_2.iso / bp_6_93 / bonus / winer / chap8.txt < prev next >

Wrap

Text File | 1994-09-01 | 118KB | 2,877 lines

CHAPTER 8 SORTING AND SEARCHING Two fundamental operations required of many applications are searching and sorting the data they operate on. Many different types of data are commonly sorted, such as customer names, payment due dates, or even a list of file names displayed in a file selection menu. If you are writing a programmer's cross reference utility, you may need to sort a list of variable names without regard to capitalization. In some cases, you may want to sort several pieces of related information based on the contents of only one of them. One example of that is a list of names and addresses sorted in ascending zip code order. Searching is equally important; for example, to locate a customer name in an array or disk file. In some cases you may wish to search for a complete match, while in others a partial match is needed. If you are searching a list of names for, say, Leonard, you probably would want to ignore Leonardo. But when searching a list of zip codes you may need to locate all that begin with the digits 068. There are many different ways sorting and searching can be accomplished, and the subject is by no means a simple one. Most programmers are familiar with the Bubble Sort, because it is the simplest to understand. Each adjacent pair of items is compared, and then exchanged if they are out of order. This process is repeated over and over, until the entire list has been examined as many times as there are items. Unfortunately, these repeated comparisons make the Bubble Sort an extremely poor performer. Similarly, code to perform a linear search that simply examines each item in succession for a match is easy to grasp, but it will be painfully slow when there are many items. In this chapter you will learn how sophisticated algorithms that handle these important programming chores operate. You will also learn how to sort data on more than one key. Often, it is not sufficient to merely sort a list of customers by their last name. For example, you may be expected to sort first by last name, then by first name, and finally by balance due. That is, all of the last names would first be sorted. Then within all of the Smiths you would sort again by first name, and for all of the John Smiths sort that subgroup based on how much money is owed. For completeness I will start each section by introducing sorting and searching methods that are easy to understand, and then progress to the more complex algorithms that are much more effective. Specifically, I will show the Quick Sort and Binary Search algorithms. When there are many thousands of data items, a good algorithm can make the difference between a sort routine that takes ten minutes to complete, and one that needs only a few seconds. Finally, I will discuss both BASIC and assembly language sort routines. As important as the right algorithm is for good performance, an assembly language implementation will be even faster. Chapter 12 describes how assembly language routines are written and how they work, and in this chapter I will merely show how to use the routines included with this book. SORTING FUNDAMENTALS ==================== Although there are many different ways to sort an array, the simplest sorting algorithm is the Bubble Sort. The name Bubble is used because a FOR/NEXT loop repeatedly examines each adjacent pair of elements in the array, and those that have higher values rise to the top like bubbles in a bathtub. The most common type of sort is ascending, which means that "A" comes before "B", which comes before "C", and so forth. Figure 8-1 shows how the name Zorba ascends to the top of a five-item list of first names. Initial array contents: Element 4 Kathy Element 3 Barbara Element 2 Cathy Element 1 Zorba < After 1 pass: Element 4 Kathy Element 3 Barbara Element 2 Zorba < Element 1 Cathy After 2 passes: Element 4 Kathy Element 3 Zorba < Element 2 Barbara Element 1 Cathy After 3 passes: Element 4 Zorba < Element 3 Kathy Element 2 Barbara Element 1 Cathy Figure 8.1: Data ascending a list during a bubble sort. The Bubble Sort routine that follows uses a FOR/NEXT loop to repeatedly examine an array and exchange elements as necessary, until all of the items are in the correct order. DEFINT A-Z DECLARE SUB BubbleSort (Array$()) CONST NumItems% = 20 CONST False% = 0 CONST True% = -1 DIM Array$(1 TO NumItems%) FOR X = 1 TO NumItems% READ Array$(X) NEXT CALL BubbleSort(Array$()) CLS FOR X = 1 TO NumItems% PRINT Array$(X) NEXT DATA Zorba, Cathy, Barbara, Kathy, Josephine DATA Joseph, Joe, Peter, Arnold, Glen DATA Ralph, Elli, Lucky, Rocky, Louis DATA Paula, Paul, Mary Lou, Marilyn, Keith END SUB BubbleSort (Array$()) STATIC DO OutOfOrder = False% 'assume it's sorted FOR X = 1 TO UBOUND(Array$) - 1 IF Array$(X) > Array$(X + 1) THEN SWAP Array$(X), Array$(X + 1) 'if we had to swap OutOfOrder = True% 'we may not be done END IF NEXT LOOP WHILE OutOfOrder END SUB This routine is simple enough to be self-explanatory, and only a few things warrant discussing. One is the OutOfOrder flag variable. When the array is nearly sorted to begin with, fewer passes through the loop are needed. The OutOfOrder variable determines when no more passes are necessary. It is cleared at the start of each loop, and set each time two elements are exchanged. If, after examining all of the elements in one pass no exchanges were required, then the sorting is done and there's no need for the DO loop to continue. The other item worth mentioning is that the FOR/NEXT loop is set to consider one element less than the array actually holds. This is necessary because each element is compared to the one above it. If the last element were included in the loop, then BASIC would issue a "Subscript out of range" error on the statement that examines Array$(X + 1). There are a number of features you can add to this Bubble Sort routine. For example, you could sort without regard to capitalization. In that case "adams" would come before "BAKER", even though the lowercase letter "a" has a higher ASCII value than the uppercase letter "B". To add that capability simply use BASIC's UCASE$ (or LCASE$) function as part of the comparisons: IF UCASE$(Array$(X)) > UCASE$(Array$(X + 1)) THEN And to sort based on the eight-character portion that starts six bytes into each string you would use this: IF MID$(Array$(X), 5, 8) > MID$(Array$(X + 1), 5, 8) THEN Although the comparisons in this example are based on just a portion of each string, the SWAP statement must exchange the entire elements. This opens up many possibilities as you will see later in this chapter. If there is a chance that the strings may contain trailing blanks that should be ignored, you can use RTRIM$ on each pair of elements: IF RTRIM$(Array$(X)) > RTRIM$(Array$(X + 1)) THEN Of course, you can easily combine these enhancements to consider only the characters in the middle after they have been converted to upper or lower case. Sorting in reverse (descending) order is equally easy; you'd simply replace the greater-than symbol (>) with a less-than symbol (<). Finally, you can modify the routine to work with any type of data by changing the array type identifier. That is, for every occurrence of Array$ you will change that to Array% or Array# or whatever is appropriate. If you are sorting a numeric array, then different modifications may be in order. For example, to sort ignoring whether the numbers are positive or negative you would use BASIC's ABS (absolute value) function: IF ABS(Array!(X)) > ABS(Array!(X + 1)) THEN It is important to point out that all of the simple modifications described here can also be applied to the more sophisticated sort routines we will look at later in this chapter. INDEXED SORTS Besides the traditional sorting methods--whether a Bubble Sort or Quick Sort or any other type of sort--there is another category of sort routine you should be familiar with. Where a conventional sort exchanges elements in an array until they are in order, an Index Sort instead exchanges elements in a parallel numeric array of *pointers*. The original data is left intact, so it may still be accessed in its natural order. However, the array can also be accessed in sorted order by using the element numbers contained in the index array. As with a conventional sort, the comparisons in an indexed sort routine examine each element in the primary array, but based on the element numbers in that index array. If it is determined that the data is out of order, the routine exchanges the elements in the index array instead of the primary array. A modification to the Bubble Sort routine to sort using an index is shown below. DEFINT A-Z DECLARE SUB BubbleISort (Array$(), Index()) CONST NumItems% = 20 CONST False% = 0 CONST True% = -1 DIM Array$(1 TO NumItems%) 'this holds the string data DIM Ndx(1 TO NumItems%) 'this holds the index FOR X = 1 TO NumItems% READ Array$(X) 'read the string data Ndx(X) = X 'initialize the index array NEXT CALL BubbleISort(Array$(), Ndx()) CLS FOR X = 1 TO NumItems% PRINT Array$(Ndx(X)) 'print based on the index NEXT DATA Zorba, Cathy, Barbara, Kathy, Josephine DATA Joseph, Joe, Peter, Arnold, Glen DATA Ralph, Elli, Lucky, Rocky, Louis DATA Paula, Paul, Mary lou, Marilyn, Keith SUB BubbleISort (Array$(), Index()) STATIC DO OutOfOrder = False% 'assume it's sorted FOR X = 1 TO UBOUND(Array$) - 1 IF Array$(Index(X)) > Array$(Index(X + 1)) THEN SWAP Index(X), Index(X + 1) 'if we had to swap OutOfOrder% = True% 'we're not done yet END IF NEXT LOOP WHILE OutOfOrder% END SUB In this indexed sort, all references to the data are through the index array. And when a swap is necessary, it is the index array elements that are exchanged. Note that an indexed sort requires that the index array be initialized to increasing values--even if the sort routine is modified to be descending instead of ascending. Therefore, when BubbleISort is called Ndx(1) must hold the value 1, Ndx(2) is set to 2, and so forth. In this example the index array is initialized by the caller. However, it would be just as easy to put that code into the subprogram itself. Since you can't pass an array that hasn't yet been dimensioned, it makes the most sense to do both steps outside of the subprogram. Either way, the index array must be assigned to these initial values. As I mentioned earlier, one feature of an indexed sort is that it lets you access the data in both its original and sorted order. But there are other advantages, and a disadvantage as well. The disadvantage is that each comparison takes slightly longer, because of the additional overhead required to first look up the element number in the index array, to determine which elements in the primary array will be compared. In some cases, though, that can be more than offset by requiring less time to exchange elements. If you are sorting an array of 230-byte TYPE variables, the time needed for SWAP to exchange the elements can become considerable. Every byte in both elements must be read and written, so the time needed increases linearly as the array elements become longer. Contrast that with the fixed two bytes in the integer index array that are swapped. Another advantage of an indexed sort is that it lends itself to sorting more data than can fit in memory. As you will see later in the section that shows how to sort files, it is far easier to manipulate an integer index than an entire file. Further, sorting the file data using multiple passes requires twice as much disk space as the file already occupies. DATA MANIPULATION TECHNIQUES Before I show the Quick Sort algorithm that will be used as a basis for the remaining sort examples in this chapter, you should also be aware of a few simple tricks that can help you maintain and sort your data. One was described in Chapter 6, using a pair of functions that pack and unpack dates such that the year is stored before the month, which in turn is before the day. Thus, date strings are reduced to only three characters each, and they can be sorted directly. Another useful speed-up trick is to store string data as integers or long integers. If you had a system of four-digit account numbers you could use an integer instead of a string. Besides saving half the memory and disk space, the integer comparisons in a sort routine will be many times faster than a comparison on string equivalents. Zip codes are also suited to this, and could be stored in a long integer. Even though the space savings is only one byte, the time needed to compare the values for sorting will be greatly reduced. This brings up another important point. As you learned in Chapter 2, all conventional (not fixed-length) strings require more memory than might be immediately apparent. Besides the amount of memory needed to hold the data itself, four additional bytes are used for a string descriptor, and two more beyond those for a back pointer. Therefore, a zip code stored as a string will actually require eleven bytes rather than the five you might expect. With this in mind, you may be tempted to think that using a fixed- length string to hold the zip codes will solve the problem. Since fixed- length strings do not use either descriptors or back pointers, they do not need the memory they occupy. And that leads to yet another issue. Whenever a fixed-length string or the string portion of a TYPE variable is compared, it must first be converted to a regular descriptored string. BASIC has only one string comparison routine, and it expects the addresses for two conventional string descriptors. Every time a fixed-length string is used as an argument for comparison, BASIC must create a temporary copy, call its comparison routine, and then delete the copy. This copying adds code and wastes an enormous amount of time; in many cases the copying will take longer than the comparison itself. Therefore, using integers and long integers for numeric data where possible will provide more improvement than just the savings in memory use. In some cases, however, you must use fixed-length string or TYPE arrays. In particular, when sorting information from a random access disk file it is most sensible to load the records into a TYPE array. And as you learned in Chapter 2, the string components of a TYPE variable or array element are handled by BASIC as a fixed-length string. So how can you effectively sort fixed-length string arrays without incurring the penalty BASIC's overhead imposes? With assembly language subroutines, of course! Rather than ask BASIC to pass the data using its normal methods, assembly language routines can be invoked passing the data segments and addresses directly. When you use SEG, or a combination of VARSEG and VARPTR with fixed-length and TYPE variables, BASIC knows that you want the segmented address of the variable or array element. Thus, you are tricking BASIC into not making a copy as it usually would when passing such data. An assembly language subroutine or function can be designed to accept data addresses in any number of ways. As you will see later when we discuss sorting on multiple keys, extra trickery is needed to do the same thing in a BASIC procedure. The three short assembly language functions that follow compare two portions of memory, and then return a result that can be tested by your program. ;COMPARE.ASM - compares two ranges of memory .Model Medium, Basic .Code Compare Proc Uses DS ES DI SI, SegAdr1:DWord, _ SegAdr2:DWord, NumBytes:Word Cld ;compare in the forward direction Mov SI,NumBytes ;get the address for NumBytes% Mov CX,[SI] ;put it into CX for comparing below Les DI,SegAdr1 ;load ES:DI with the first ; segmented address Lds SI,SegAdr2 ;load DS:SI with the second ; segmented address Repe Cmpsb ;do the compare Mov AX,0 ;assume the bytes didn't match Jne Exit ;we were right, skip over Dec AX ;wrong, decrement AX down to -1 Exit: Ret ;return to BASIC Compare Endp End ;COMPARE2.ASM - compares memory case-insensitive .Model Medium, Basic .Code Compare2 Proc Uses DS ES DI SI, SegAdr1:DWord, _ SegAdr2:DWord, NumBytes:Word Cld ;compare in the forward direction Mov BX,-1 ;assume the ranges are the same Mov SI,NumBytes ;get the address for NumBytes% Mov CX,[SI] ;put it into CX for comparing below Jcxz Exit ;if zero bytes were given, they're ; the same Les DI,SegAdr1 ;load ES:DI with the first address Lds SI,SegAdr2 ;load DS:SI with the second address Do: Lodsb ;load the current character from ; DS:SI into AL Call Upper ;capitalize as necessary Mov AH,AL ;copy the character to AH Mov AL,ES:[DI] ;load the other character into AL Inc DI ;point at the next one for later Call Upper ;capitalize as necessary Cmp AL,AH ;now, are they the same? Jne False ;no, exit now and show that Loop Do ;yes, continue Jmp Short Exit ;if we get this far, the bytes are ; all the same False: Inc BX ;increment BX to return zero Exit: Mov AX,BX ;assign the function output Ret ;return to BASIC Upper: Cmp AL,"a" ;is the character below an "a"? Jb Done ;yes, so we can skip it Cmp AL,"z" ;is the character above a "z"? Ja Done ;yes, so we can skip that too Sub AL,32 ;convert to upper case Done: Retn ;do a near return to the caller Compare2 Endp End ;COMPARE3.ASM - case-insensitive, greater/less than .Model Medium, Basic .Code Compare3 Proc Uses DS ES DI SI, SegAdr1:DWord, _ SegAdr2:DWord, NumBytes:Word Cld ;compare in the forward direction Xor BX,BX ;assume the ranges are the same Mov SI,NumBytes ;get the address for NumBytes% Mov CX,[SI] ;put it into CX for comparing below Jcxz Exit ;if zero bytes were given, they're ; the same Les DI,SegAdr1 ;load ES:DI with the first address Lds SI,SegAdr2 ;load DS:SI with the second address Do: Lodsb ;load the current character from ; DS:SI into AL Call Upper ;capitalize as necessary, remove for ; case-sensitive Mov AH,AL ;copy the character to AH Mov AL,ES:[DI] ;load the other character into AL Inc DI ;point at the next character for later Call Upper ;capitalize as necessary, remove for ; case-sensitive Cmp AL,AH ;now, are they the same? Loope Do ;yes, continue Je Exit ;we exhausted the data and they're ; the same Mov BL,1 ;assume block 1 was "greater" Ja Exit ;we assumed correctly Dec BX ;wrong, bump BX down to -1 Dec BX Exit: Mov AX,BX ;assign the function output Ret ;return to BASIC Upper: Cmp AL,"a" ;is the character below an "a"? Jb Done ;yes, so we can skip it Cmp AL,"z" ;is the character above a "z"? Ja Done ;yes, so we can skip that too Sub AL,32 ;convert to upper case Done: Retn ;do a near return to the caller Compare3 Endp End The first Compare routine above simply checks if all of the bytes are identical, and returns -1 (True) if they are, or 0 (False) if they are not. By returning -1 or 0 you can use either IF Compare%(Type1, Type2, NumBytes%) THEN or IF NOT Compare%(Type1, Type2, NumBytes%) THEN depending on which logic is clearer for your program. Compare2 is similar to Compare, except it ignores capitalization. That is, "SMITH" and Smith" are considered equal. The Compare3 function also compares memory and ignores capitalization, but it returns either -1, 0, or 1 to indicate if the first data range is less than, equal to, or greater than the second. The correct declaration and usage for each of these routines is shown below. Note that Compare and Compare2 are declared and used in the same fashion. Compare and Compare2: DECLARE FUNCTION Compare%(SEG Type1 AS ANY, SEG Type2 AS ANY, _ NumBytes%) Same = Compare%(Type1, Type2, NumBytes%) or DECLARE FUNCTION Compare%(BYVAL Seg1%, BYVAL Adr1%, BYVAL Seg2%, _ BYVAL Adr2%, NumBytes%) Same = Compare%(Seg1%, Adr1%, Seg2%, Adr2%, NumBytes%) Here, Same receives -1 if the two TYPE variables or ranges of memory are the same, or 0 if they are not. NumBytes% tells how many bytes to compare. Compare3: DECLARE FUNCTION Compare3%(SEG Type1 AS ANY, SEG Type2 AS ANY, _ NumBytes%) Result = Compare3%(Type1, Type2, NumBytes%) or DECLARE FUNCTION Compare3%(BYVAL Seg1%, BYVAL Adr1%, BYVAL Seg2%, _ BYVAL Adr2%, NumBytes%) Result = Compare3%(Seg1%, Adr1%, Seg2%, Adr2%, NumBytes%) Result receives 0 if the two type variables or ranges of memory are the same, -1 if the first is less when compared as strings, or 1 if the first is greater. NumBytes% tells how many bytes are to be to compared. In the context of a sort routine you could invoke Compare3 like this: IF Compare3%(TypeEl(X), TypeEl(X + 1), NumBytes%) = 1 THEN SWAP TypeEl(X), TypeEl(X + 1) END IF As you can see, these routines may be declared in either of two ways. When used with TYPE arrays the first is more appropriate and results in slightly less setup code being generated by the compiler. When comparing fixed-length strings or arbitrary blocks of memory (for example, when one of the ranges is on the display screen) you should use the second method. Since SEG does not work correctly with fixed-length strings, if you want to use that more efficient version you must create a dummy TYPE comprised solely of a single string portion: TYPE FixedLength Something AS STRING * 35 END TYPE Then simply use DIM to create a single variable or an array based on this or a similar TYPE, depending on what your program needs. The requirement to create a dummy TYPE was discussed in Chapter 2, and I won't belabor the reasons again here. These comparison routines will be used extensively in the sort routines presented later in this chapter; however, their value in other, non-sorting situations should also be apparent. Although these routines are written in assembly language, they are fairly simple to follow. It is important to understand that you do not need to know anything about assembly language to use them. All of the files you need to add these and all of the other routines in this book are contained on the accompanying diskette [here, in the same ZIP file as this text]. Chapter 12 discusses assembly language in great detail, and you can refer there for further explanation of the instructions used. If you plan to run the programs that follow in the QuickBASIC editor, you must load the BASIC.QLB Quick Library as follows: qb program /l basic Later when you compile these or other programs you must link with the parallel BASIC.LIB file: bc program [/o]; link program , , nul , basic; If you are using BASIC PDS start QBX using the BASIC7.QLB file, and then link with BASIC7.LIB to produce a stand-alone .EXE program. [VB/DOS users will also use the BASIC7 version.] THE QUICK SORT ALGORITHM ======================== It should be obvious to you by now that a routine written in assembly language will always be faster than an equivalent written in BASIC. However, simply translating a procedure to assembly language is not always the best solution. Far more important than which language you use is selecting an appropriate algorithm. The best sorting method I know is the Quick Sort, and a well-written version of Quick Sort using BASIC will be many times faster than an assembly language implementation of the Bubble Sort. The main problem with the Bubble Sort is that the number of comparisons required grows exponentially as the number of elements increases. Since each pass through the array exchanges only a few elements, many passes are required before the entire array is sorted. The Quick Sort was developed by C.A.R. (Tony) Hoare, and is widely recognized as the fastest algorithm available. In some special cases, such as when the data is already sorted or nearly sorted, the Quick Sort may be slightly slower than other methods. But in most situations, a Quick Sort is many times faster than any other sorting algorithm. As with the Bubble Sort, there are many different variations on how a Quick Sort may be coded. (You may have noticed that the Bubble Sort shown in Chapter 7 used a nested FOR/NEXT loop, while the one shown here uses a FOR/NEXT loop within a DO/WHILE loop.) A Quick Sort divides the array into sections--sometimes called partitions--and then sorts each section individually. Many implementations therefore use recursion to invoke the subprogram from within itself, as each new section is about to be sorted. However, recursive procedures in any language are notoriously slow, and also consume stack memory at an alarming rate. The Quick Sort version presented here avoids recursion, and instead uses a local array as a form of stack. This array stores the upper and lower bounds showing which section of the array is currently being considered. Another refinement I have added is to avoid making a copy of elements in the array. As a Quick Sort progresses, it examines one element selected arbitrarily from the middle of the array, and compares it to the elements that lie above and below it. To avoid assigning a temporary copy this version simply keeps track of the selected element number. When sorting numeric data, maintaining a copy of the element is reasonable. But when sorting strings--especially strings whose length is not known ahead of time--the time and memory required to keep a copy can become problematic. For clarity, the generic Quick Sort shown below uses the copy method. Although this version is meant for sorting a single precision array, it can easily be adapted to sort any type of data by simply changing all instances of the "!" type declaration character. '******** QSORT.BAS, Quick Sort algorithm demonstration 'Copyright (c) 1991 Ethan Winer DEFINT A-Z DECLARE SUB QSort (Array!(), StartEl, NumEls) RANDOMIZE TIMER 'generate a new series each run DIM Array!(1 TO 21) 'create an array FOR X = 1 TO 21 'fill with random numbers Array!(X) = RND(1) * 500 'between 0 and 500 NEXT FirstEl = 6 'sort starting here NumEls = 10 'sort this many elements CLS PRINT "Before Sorting:"; TAB(31); "After sorting:" PRINT "==============="; TAB(31); "==============" FOR X = 1 TO 21 'show them before sorting IF X >= FirstEl AND X <= FirstEl + NumEls - 1 THEN PRINT "==>"; END IF PRINT TAB(5); USING "###.##"; Array!(X) NEXT CALL QSort(Array!(), FirstEl, NumEls) LOCATE 3 FOR X = 1 TO 21 'print them after sorting LOCATE , 30 IF X >= FirstEl AND X <= FirstEl + NumEls - 1 THEN PRINT "==>"; 'point to sorted items END IF LOCATE , 35 PRINT USING "###.##"; Array!(X) NEXT SUB QSort (Array!(), StartEl, NumEls) STATIC REDIM QStack(NumEls \ 5 + 10) 'create a stack array First = StartEl 'initialize work variables Last = StartEl + NumEls - 1 DO DO Temp! = Array!((Last + First) \ 2) 'seek midpoint I = First J = Last DO 'reverse both < and > below to sort descending WHILE Array!(I) < Temp! I = I + 1 WEND WHILE Array!(J) > Temp! J = J - 1 WEND IF I > J THEN EXIT DO IF I < J THEN SWAP Array!(I), Array!(J) I = I + 1 J = J - 1 LOOP WHILE I <= J IF I < Last THEN QStack(StackPtr) = I 'Push I QStack(StackPtr + 1) = Last 'Push Last StackPtr = StackPtr + 2 END IF Last = J LOOP WHILE First < Last IF StackPtr = 0 THEN EXIT DO 'Done StackPtr = StackPtr - 2 First = QStack(StackPtr) 'Pop First Last = QStack(StackPtr + 1) 'Pop Last LOOP ERASE QStack 'delete the stack array END SUB Notice that I have designed this routine to allow sorting only a portion of the array. To sort the entire array you'd simply omit the StartEl and NumEls parameters, and assign First and Last from the LBOUND and UBOUND element numbers. That is, you will change these: First = StartEl and Last = StartEl + NumEls - 1 to these: First = LBOUND(Array!) and Last = UBOUND(Array!) As I mentioned earlier, the QStack array serves as a table of element numbers that reflect which range of elements is currently being considered. You will need to dimension this array to one element for every five elements in the primary array being sorted, plus a few extra for good measure. In this program I added ten elements, because one stack element for every five main array elements is not enough for very small arrays. For data arrays that have a large amount of duplicated items, you will probably need to increase the size of the stack array. Note that this ratio is not an absolute--the exact size of the stack that is needed depends on how badly out of order the data is to begin with. Although it is possible that one stack element for every five in the main array is insufficient in a given situation, I have never seen this formula fail. Because the stack is a dynamic integer array that is stored in far memory, it will not impinge on near string memory. If this routine were designed using the normal recursive method, BASIC's stack would be used which is in near memory. Each of the innermost DO loops searches the array for the first element in each section about the midpoint that belongs in the other section. If the elements are indeed out of order (when I is less than J) the elements are exchanged. This incrementing and comparing continues until I and J cross. At that point, assuming the variable I has not exceeded the upper limits of the current partition, the partition bounds are saved and Last is assigned to the top of the next inner partition level. When the entire partition has been processed, the previous bounds are retrieved, but as a new set of First and Last values. This process continues until no more partition boundaries are on the stack. At that point the entire array is sorted. On the accompanying disk you will find a program called SEEQSORT.BAS that contains an enhanced version of the QSort demo and subprogram. This program lets you watch the progress of the comparisons and exchanges as they are made, and actually see this complex algorithm operate. Simply load SEEQSORT.BAS into the BASIC editor and run it. A constant named Delay! is defined at the beginning of the program. Increasing its value makes the program run more slowly; decreasing it causes the program to run faster. AN ASSEMBLY LANGUAGE QUICK SORT As fast as the BASIC QuickSort routine is, we can make it even faster. The listing below shows an assembly language version that is between ten and twenty percent faster, depending on which compiler you are using and if the BASIC PDS /fs (far strings) option is in effect. ;SORT.ASM - sorts an entire BASIC string array .Model Medium, Basic .Data S DW 0 F DW 0 L DW 0 I DW 0 J DW 0 MidPoint DW 0 .Code Extrn B$SWSD:Proc ;this swaps two strings Extrn B$SCMP:Proc ;this compares two strings Sort Proc Uses SI DI ES, Array:Word, Dir:Word Cld ;all fills and compares are forward Push DS ;set ES = DS for string compares Pop ES Xor CX,CX ;clear CX Mov AX,7376h ;load AL and AH with the opcodes ; Jae and Jbe in preparation for ; code self-modification Mov BX,Dir ;get the sorting direction Cmp [BX],CX ;is it zero (ascending sort)? Je Ascending ;yes, skip ahead Xchg AL,AH ;no exchange the opcodes Ascending: Mov CS:[X1],AH ;install correct comparison opcodes Mov CS:[X2],AL ; based on the sort direction Mov BX,Array ;load the array descriptor address Mov AX,[BX+0Eh] ;save the number of elements Dec AX ;adjust the number to zero-based Jns L0 ;at least 1 element, continue Jmp L4 ;0 or less elements, get out now! L0: Mov BX,Array ;reload array descriptor address Mov BX,[BX] ;Array$(LBOUND) descriptor address Mov S,SP ;StackPtr = 0 (normalized to SP) Mov F,CX ;F = 0 Mov L,AX ;L = Size% ;----- calculate the value of MidPoint L1: Mov DI,L ;MidPoint = (L + F) \ 2 Add DI,F Shr DI,1 Mov MidPoint,DI Mov AX,F ;I = F Mov I,AX Mov AX,L ;J = L Mov J,AX ;----- calculate the offset into the descriptor table for Array$(MidPoint) L1_2: Shl DI,1 ;multiply MidPoint in DI times 4 Shl DI,1 ;now DI holds how far beyond Array$(Start) ; Array$(MidPoint)'s descriptor is Add DI,BX ;add the array base address to produce the final ; address for Array$(MidPoint) ;----- calculate descriptor offset for Array$(I) L2: Mov SI,I ;put I into SI Shl SI,1 ;as above Shl SI,1 ;now SI holds how far beyond Array$(Start) ; Array$(I)'s descriptor is Add SI,BX ;add the base to produce the final descriptor ; address ;IF Array$(I) < Array$(MidPoint) THEN I = I + 1: GOTO L2 Push BX ;save BX because B$SCMP trashes it Push SI Push DI Call B$SCMP ;do the compare Pop BX ;restore BX X1 Label Byte ;modify the code below to "Jbe" if descending sort Jae L2_1 ;Array$(I) isn't less, continue on Inc Word Ptr I ;I = I + 1 Jmp Short L2 ;GOTO L2 ;----- calculate descriptor offset for Array$(J) L2_1: Mov SI,J ;put J into SI Shl SI,1 ;as above Shl SI,1 ;now SI holds how far beyond Array$(Start) ; Array$(J)'s descriptor is Add SI,BX ;add the base to produce the final descriptor ; address ;IF Array$(J) > Array$(MidPoint) THEN J = J - 1: GOTO L2.1 Push BX ;preserve BX Push SI Push DI Call B$SCMP ;do the compare Pop BX ;restore BX X2 Label Byte ;modify the code below to "Jae" if descending sort Jbe L2_2 ;Array$(J) isn't greater, continue on Dec Word Ptr J ;J = J - 1 Jmp Short L2_1 ;GOTO L2.1 L2_2: Mov AX,I ;IF I > J GOTO L3 Cmp AX,J Jg L3 ;J is greater, go directly to L3 Je L2_3 ;they're the same, skip the swap ;Swap Array$(I), Array$(J) Mov SI,I ;put I into SI Mov DI,J ;put J into DI Cmp SI,MidPoint ;IF I = MidPoint THEN MidPoint = J Jne No_Mid1 ;not equal, skip ahead Mov MidPoint,DI ;equal, assign MidPoint = J Jmp Short No_Mid2 ;don't waste time comparing again No_Mid1: Cmp DI,MidPoint ;IF J = MidPoint THEN MidPoint = I Jne No_Mid2 ;not equal, skip ahead Mov MidPoint,SI ;equal, assign MidPoint = I No_Mid2: Mov SI,I ;put I into SI Shl SI,1 ;multiply times four for the Shl SI,1 ; for the descriptors Add SI,BX ;add address for first descriptor Mov DI,J ;do the same for J in DI Shl DI,1 Shl DI,1 Add DI,BX Push BX ;save BX because B$SWSD destroys it Call B$SWSD ;and swap 'em good Pop BX L2_3: Inc Word Ptr I ;I = I + 1 Dec Word Ptr J ;J = J - 1 Mov AX,I ;IF I <= J GOTO L2 Cmp AX,J Jg L3 ;it's greater, skip to L3 Mov DI,MidPoint ;get MidPoint again Jmp L1_2 ;go back to just before L2 L3: Mov AX,I ;IF I < L THEN PUSH I: PUSH L Cmp AX,L Jnl L3_1 ;it's not less, so skip Pushes Push I ;Push I Push L ;Push L L3_1: Mov AX,J ;L = J Mov L,AX Mov AX,F ;IF F < L GOTO L1 Cmp AX,L Jnl L3_2 ;it's not less, jump ahead to L3_2 Jmp L1 ;it's less, go to L1 L3_2: Cmp S,SP ;IF S = 0 GOTO L4 Je L4 Pop L ;Pop L Pop F ;Pop F Jmp L1 ;GOTO L1 L4: Ret ;return to BASIC Sort Endp End Besides being faster than the BASIC version, the assembly language Sort routine is half the size. This version also supports sorting either forward or backward, but not just a portion of an array. The general syntax is: CALL Sort(Array$(), Direction) Where Array$() is any variable-length string array, and Direction is 0 for ascending, or any other value for descending. Note that this routine calls upon BASIC's internal services to perform the actual comparing and swapping; therefore, the exact same code can be used with either QuickBASIC or BASIC PDS. Again, I refer you forward to Chapter 12 for an explanation of the assembly language commands used in SORT.ASM. SORTING ON MULTIPLE KEYS In many situations, sorting based on one key is sufficient. For example, if you are sorting a mailing list to take advantage of bulk rates you must sort all of the addresses in order by zip code. When considering complex data such as a TYPE variable, it is easy to sort the array based on one component of each element. The earlier Bubble Sort example showed how MID$ could be used to consider just a portion of each string, even though the entire elements were exchanged. Had that routine been designed to operate on a TYPE array, the comparisons would have examined just one component, but the SWAP statements would exchange entire elements: IF Array(X).ZipCode > Array(X + 1).ZipCode THEN SWAP Array(X), Array(X + 1) END IF This way, each customer's last name, first name, street address, and so forth remain connected to the zip codes that are being compared and exchanged. There are several ways to sort on more than one key, and all are of necessity more complex than simply sorting based on a single key. One example of a multi-key sort first puts all of the last names in order. Then within each group of identical last names the first names are sorted, and within each group of identical last and first names further sorting is performed on yet another key--perhaps Balance Due. As you can see, this requires you to sort based on differing types of data, and also to compare ranges of elements for the subgroups that need further sorting. The biggest complication with this method is designing a calling syntax that lets you specify all of the information. A table array must be established to hold the number of keys, the type of data in each key (string, double precision, and so forth), and how many bytes into the TYPE element each key portion begins. Worse, you can't simply use the name of a TYPE component in the comparisons inside the sort routine--which would you use: Array(X).LastName, Array(X).FirstName, or Array(X).ZipCode? Therefore, a truly general multi-key sort must be called passing the address where the array begins in memory, and a table of offsets beyond that address where each component being considered is located. To avoid this added complexity I will instead show a different method that has only a few minor restrictions, but is much easier to design and understand. This method requires you to position each TYPE component into the key order you will sort on. You will also need to store all numbers that will be used for a sort key as ASCII digits. To sort first on last name, then first name, and then on balance due, the TYPE might be structured as follows: TYPE Customer LastName AS STRING * 15 FirstName AS STRING * 15 BalanceDue AS STRING * 9 Street AS STRING * 32 City AS STRING * 15 State AS STRING * 2 ZipCode AS STRING * 5 AnyNumber AS DOUBLE END TYPE In most cases the order in which each TYPE member is placed has no consequence. When you refer to TypeVar.LastName, BASIC doesn't care if LastName is defined before or after FirstName in the TYPE structure. Either way it translates your reference to LastName into an address. Having to store numeric data as strings is a limitation, but this is needed only for those TYPE fields that will be used as a sort key. The key to sorting on multiple items simultaneously is by treating the contiguous fields as a single long field. Since assignments to the string portion of a TYPE variable are handled internally by BASIC's LSET routine, the data in each element will be aligned such that subsequent fields can be treated as an extension of the primary field. Figure 8-2 below shows five TYPE array elements in succession, as they would be viewed by a string comparison routine. This data is defined as a subset of the name and address TYPE shown above, using just the first three fields. Notice that the balance due fields must be right-aligned (using RSET) for the numeric values to be considered correctly. Type.LastName Type.FirstName Type.BalanceDue ===============---------------========= Munro Jay 8000.00 Smith John 122.03 Johnson Alfred 14537.89 Rasmussen Peter 100.90 Hudson Cindy 21.22 ^ ^ ^ Field 1 Field 2 Field 3 starts here starts here starts here Figure 8-2: Multiple contiguous fields in a TYPE can be treated as a single long field. Thus, the sort routine would be told to start at the first field, and consider the strings to be 15 + 15 + 9 = 39 characters long. This way all three fields are compared at one time, and treated as a single entity. Additional fields can of course follow these, and they may be included in the comparison or not at your option. The combination demonstration and subroutine below sorts such a TYPE array on any number of keys using this method, and it has a few additional features as well. Besides letting you confine the sorting to just a portion of the array, you may also specify how far into each element the first key is located. As long as the key fields are contiguous, they do not have to begin at the start of each TYPE. Therefore, you could sort just on the first name field, or on any other field or group of fields. 'TYPESORT.BAS - performs a multi-key sort on TYPE arrays 'Copyright (c) 1991 Ethan Winer DEFINT A-Z DECLARE FUNCTION Compare3% (BYVAL Seg1, BYVAL Adr1, BYVAL Seg2, _ BYVAL Adr2, NumBytes) DECLARE SUB SwapMem (BYVAL Seg1, BYVAL Adr1, BYVAL Seg2, BYVAL Adr2, _ BYVAL Length) DECLARE SUB TypeSort (Segment, Address, ElSize, Offset, KeySize, NumEls) CONST NumEls% = 23 'this keeps it all on the screen TYPE MyType LastName AS STRING * 10 FirstName AS STRING * 10 Dollars AS STRING * 6 Cents AS STRING * 2 END TYPE REDIM Array(1 TO NumEls%) AS MyType '---- Disable (REM out) all but one of the following blocks to test Offset = 27 'start sorting with Cents ElSize = LEN(Array(1)) 'the length of each element KeySize = 2 'sort on the Cents only Offset = 21 'start sorting with Dollars ElSize = LEN(Array(1)) 'the length of each element KeySize = 8 'sort Dollars and Cents only Offset = 11 'start sorting with FirstName ElSize = LEN(Array(1)) 'the length of each element KeySize = 18 'sort FirstName through Cents Offset = 1 'start sorting with LastName ElSize = LEN(Array(1)) 'the length of each element KeySize = ElSize 'sort based on all 4 fields FOR X = 1 TO NumEls% 'build the array from DATA READ Array(X).LastName READ Array(X).FirstName READ Amount$ 'format the amount into money Dot = INSTR(Amount$, ".") IF Dot THEN RSET Array(X).Dollars = LEFT$(Amount$, Dot - 1) Array(X).Cents = LEFT$(MID$(Amount$, Dot + 1) + "00", 2) ELSE RSET Array(X).Dollars = Amount$ Array(X).Cents = "00" END IF NEXT Segment = VARSEG(Array(1)) 'show where the array is Address = VARPTR(Array(1)) ' located in memory CALL TypeSort(Segment, Address, ElSize, Offset, KeySize, NumEls%) CLS 'display the results FOR X = 1 TO NumEls% PRINT Array(X).LastName, Array(X).FirstName, PRINT Array(X).Dollars; "."; Array(X).Cents NEXT DATA Smith, John, 123.45 DATA Cramer, Phil, 11.51 DATA Hogan, Edward, 296.08 DATA Cramer, Phil, 112.01 DATA Malin, Donald, 13.45 DATA Cramer, Phil, 111.3 DATA Smith, Ralph, 123.22 DATA Smith, John, 112.01 DATA Hogan, Edward, 8999.04 DATA Hogan, Edward, 8999.05 DATA Smith, Bob, 123.45 DATA Cramer, Phil, 11.50 DATA Hogan, Edward, 296.88 DATA Malin, Donald, 13.01 DATA Cramer, Phil, 111.1 DATA Smith, Ralph, 123.07 DATA Smith, John, 112.01 DATA Hogan, Edward, 8999.33 DATA Hogan, Edward, 8999.17 DATA Hogan, Edward, 8999.24 DATA Smith, John, 123.05 DATA Cramer, David, 1908.80 DATA Cramer, Phil, 112 END SUB TypeSort (Segment, Address, ElSize, Displace, KeySize, NumEls) STATIC REDIM QStack(NumEls \ 5 + 10) 'create a stack array First = 1 'initialize working variables Last = NumEls Offset = Displace - 1 'decrement once now rather than ' repeatedly later DO DO Temp = (Last + First) \ 2 'seek midpoint I = First J = Last DO WHILE Compare3%(Segment, Address + Offset + (I - 1) * ElSize, Segment, _ Address + Offset + (Temp-1) * ElSize, KeySize) = -1 '< 1 for descending I = I + 1 WEND WHILE Compare3%(Segment, Address + Offset + (J - 1) * ElSize, Segment, _ Address + Offset + (Temp-1) * ElSize, KeySize) = 1 '< -1 for descending J = J - 1 WEND IF I > J THEN EXIT DO IF I < J THEN CALL SwapMem(Segment, Address + (I - 1) * ElSize, Segment, _ Address + (J - 1) * ElSize, ElSize) IF Temp = I THEN Temp = J ELSEIF Temp = J THEN Temp = I END IF END IF I = I + 1 J = J - 1 LOOP WHILE I <= J IF I < Last THEN QStack(StackPtr) = I 'Push I QStack(StackPtr + 1) = Last 'Push Last StackPtr = StackPtr + 2 END IF Last = J LOOP WHILE First < Last IF StackPtr = 0 THEN EXIT DO 'Done StackPtr = StackPtr - 2 First = QStack(StackPtr) 'Pop First Last = QStack(StackPtr + 1) 'Pop Last LOOP ERASE QStack 'delete the stack array END SUB As you can see, this version of the Quick Sort subprogram is derived from the one shown earlier. The important difference is that all of the incoming information is passed as segments, addresses, and bytes, rather than using an explicit array name. But before describing the inner details of the subprogram itself, I'll address the demonstration portion and show how the routine is set up and called. As with some of the other procedures on the disk that comes with this book, you will extract the TypeSort subprogram and add it to your own programs by loading it as a module, and then using the Move option of BASIC's View Subs menu. You can quickly access this menu by pressing F2, and then use Alt-M to select Move. Once this is done you will unload TYPESORT.BAS using the Alt-F-U menu selection, and answer *No* when asked if you want to save the modified file. You could also copy the TypeSort subprogram into a separate file, and then load that file as a module in each program that needs it. Although the example TYPE definition here shows only four components, you may of course use any TYPE structure. TypeSort expects six parameters to tell it where in memory the array is located, how far into each element the comparison routines are to begin, the total length of each element, the length of the key fields, and the number of elements to sort. After defining MyType, the setup portion of TYPESORT.BAS establishes the offset, element size, and key size parameters. As you can see, four different sample setups are provided, and you should add remarking apostrophes to all but one of them. If the program is left as is, the last setup values will take precedence. The next section reads sample names, addresses and dollar amounts from DATA statements, and formats the dollar amounts as described earlier. The dollar portion of the amounts are right justified into the Dollars field of each element, and the Cents portion is padded with trailing zeros as necessary to provide a dollars and cents format. This way, the value 12.3 will be assigned as 12.30, and 123 will be formatted to 123.00 which gives the expected appearance. The final setup step is to determine where the array begins in memory. Since you specify the starting segment and address, it is simple to begin sorting at any array element. For example, to sort elements 100 through 200--even if the array is larger than that--you'd use VARSEG(Array(100)) and VARPTR(Array(100) instead of element 1 as shown in this example. In addition to the starting segment and address of the array, TypeSort also requires you to tell it how many elements to consider. If you are sorting the entire array and the array starts with element 1, this will simply be the UBOUND of the array. If you are sorting just a portion of the array then you give it only the number of elements to be sorted. So to sort elements 100 through 200, the number of elements will be 101. A general formula you can use for calculating this based on element numbers is NumElements = LastElement - FirstElement + 1. Now let's consider the TypeSort subprogram itself. Since it is more like the earlier QSort program than different, I will cover only the differences here. In fact, the primary difference is in the way comparisons and exchanges are handled. The Compare3 function introduced earlier is used to compare the array elements with the midpoint. Although QSort made a temporary copy of the midpoint element, that would be difficult to do here. Since the routine is designed to work with any type of data--and the size of each element can vary depending on the TYPE structure--it is impractical to make a copy. While SPACE$ could be used to claim a block of memory into which the midpoint element is copied, there's a much better way: the Temp variable is used to remember the element number itself. The only complication is that once elements I and J are swapped, Temp must be reassigned if it was equal to either of them. (This happens just below the call to SwapMem.) But the simple integer IF test and assignment required adds far less code and is much faster than making a copy of the element. TypeSort is designed to sort the array in ascending order, and comments in the code show how to change it to sort descending instead. If you prefer to have one subprogram that can do both, you should add an extra parameter, perhaps called Direction. Near the beginning of the routine before the initial outer DO you would add this: IF Direction = 0 THEN 'sort ascending ICompare = -1 JCompare = 1 ELSE 'sort descending ICompare = 1 JCompare = -1 END IF Then, where the results from Compare3 are compared to -1 and 1 replace those comparisons (at the end of each WHILE line) to instead use ICompare and JCompare: WHILE Compare3%(...) = ICompare I = I + 1 WEND WHILE Compare3%(...) = JCompare J = J - 1 WEND This way, you are using variables to establish the sorting direction, and those variables can be set either way each time TypeSort is called. The last major difference is that elements are exchanged using the SwapMem routine rather than BASIC's SWAP statement. While it is possible to call SWAP by aliasing its name as shown in Chapter 5, it was frankly simpler to write a new routine for this purpose. Further, BASIC's SWAP is slower than SwapMem because it must be able to handle variables of different lengths, and also exchange fixed-length and conventional strings. SwapMem is extremely simple, and it works very quickly. As I stated earlier, the only way to write a truly generic sort routine is by passing segments and addresses and bytes, instead of array names. Although it would be great if BASIC could let you declare a subprogram or function using the AS ANY option to allow any type of data, that simply wouldn't work. As BASIC compiles your program, it needs to know the size and type of each parameter. When you reference TypeVar.LastName, BASIC knows where within TypeVar the LastName portion begins, and uses that in its address calculations. It is not possible to avoid this limitation other than by using addresses as is done here. Indeed, this is the stuff that C and assembly language programs are made of. In these languages--especially assembly language--integer pointer variables are used extensively to show where data is located and how long it is. However, the formulas used within the Compare3 and SwapMem function calls are not at all difficult to understand. The formula Address + Offset - (I - 1) * ElSize indicates where the key field of element I begins. Address holds the address of the beginning of the first element, and Offset is added to identify the start of the first sort key. (I - 1) is used instead of I because addresses are always zero- based. That is, the first element in the array from TypeSort's perspective is element 0, even though the calling program considers it to be element 1. Finally, the element number is multiplied times the length of each element, to determine the value that must be added to the starting address and offset to obtain the final address for the data in element I. Please understand that calculations such as these are what the compiler must do each time you access an array element. Note that if you call TypeSort incorrectly or give it illegal element numbers, you will not receive a "Subscript out of range" error from BASIC. Rather, you will surely crash your PC and have to reboot. This is the danger--and fun--of manipulating pointers directly. As I stated earlier, the SwapMem routine that does the actual exchanging of elements is very simple, and it merely takes a byte from one element and exchanges it with the corresponding byte in the other. This task is greatly simplified by the use of the XCHG assembly language command, which is similar to BASIC's SWAP statement. Although XCHG cannot swap a word in memory with another word in memory, it can exchange memory with a register. SwapMem is shown in the listing below. ;SWAPMEM.ASM, swaps two sections of memory .Model Medium, Basic .Code SwapMem Proc Uses SI DI DS ES, Var1:DWord, Var2:DWord, NumBytes:Word Lds SI,Var1 ;get the segmented address of the ; first variable Les DI,Var2 ;and for the second variable Mov CX,NumBytes ;get the number of bytes to exchange Jcxz Exit ;we can't swap zero bytes! DoSwap: Mov AL,ES:[DI] ;get a byte from the second variable Xchg AL,[SI] ;swap it with the first variable Stosb ;complete the swap and increment DI Inc SI ;point to the next source byte Loop DoSwap ;continue until done Exit: Ret ;return to BASIC SwapMem Endp End INDEXED SORTING ON MULTIPLE KEYS Earlier I showed how to modify the simple Bubble Sort routine to sort a parallel index array instead of the primary array. One important reason you might want to do that is to allow access to the primary array in both its original and sorted order. Another reason, and one we will get to shortly, is to facilitate sorting disk files. Although a routine to sort the records in a file could swap the actual data, it takes a long time to read and write that much data on disk. Further, each time you wanted to access the data sorted on a different key, the entire file would need to be sorted again. A much better solution is to create one or more sorted lists of record numbers, and store those on disk each in a separate file. This lets you access the data sorted by name, or by zip code, or by any other field, without ever changing the actual file. The TypeISort subprogram below is adapted from TypeSort, and it sorts an index array that holds the element numbers of a TYPE array. 'TYPISORT.BAS, indexed multi-key sort for TYPE arrays DEFINT A-Z DECLARE FUNCTION Compare3% (BYVAL Seg1, BYVAL Adr1, BYVAL Seg2, _ BYVAL Adr2, NumBytes) DECLARE SUB SwapMem (BYVAL Seg1, BYVAL Adr1, BYVAL Seg2, _ BYVAL Adr2, BYVAL Length) DECLARE SUB TypeISort (Segment, Address, ElSize, Offset, KeySize, _ NumEls, Index()) CONST NumEls% = 23 'this keeps it all on the screen TYPE MyType LastName AS STRING * 10 FirstName AS STRING * 10 Dollars AS STRING * 6 Cents AS STRING * 2 END TYPE REDIM Array(1 TO NumEls%) AS MyType REDIM Index(1 TO NumEls%) 'create the index array Offset = 1 'start sorting with LastName ElSize = LEN(Array(1)) 'the length of each element KeySize = ElSize 'sort based on all 4 fields FOR X = 1 TO NumEls% 'build the array from DATA READ Array(X).LastName READ Array(X).FirstName READ Amount$ ... 'this continues as already ... ' shown in TypeSort NEXT FOR X = 1 TO NumEls% 'initialize the index Index(X) = X - 1 'but starting with 0 NEXT Segment = VARSEG(Array(1)) 'show where the array is Address = VARPTR(Array(1)) ' located in memory CALL TypeISort(Segment, Address, ElSize, Offset, KeySize, NumEls%, Index()) CLS 'display the results FOR X = 1 TO NumEls% '+ 1 adjusts to one-based PRINT Array(Index(X) + 1).LastName, PRINT Array(Index(X) + 1).FirstName, PRINT Array(Index(X) + 1).Dollars; "."; PRINT Array(Index(X) + 1).Cents NEXT DATA Smith, John, 123.45 'this continues as already ... ' shown in TypeSort ... END SUB TypeISort (Segment, Address, ElSize, Displace, KeySize, NumEls, _ Index()) STATIC REDIM QStack(NumEls \ 5 + 10) 'create a stack First = 1 'initialize working variables Last = NumEls Offset = Displace - 1 'make zero-based now for speed later DO DO Temp = (Last + First) \ 2 'seek midpoint I = First J = Last DO 'change -1 to 1 and 1 to -1 to sort descending WHILE Compare3%(Segment, Address + Offset + (Index(I) * ElSize), _ Segment, Address + Offset + (Index(Temp) * ElSize), KeySize) = -1 I = I + 1 WEND WHILE Compare3%(Segment, Address + Offset + (Index(J) * ElSize), _ Segment, Address + Offset + (Index(Temp) * ElSize), KeySize) = 1 J = J - 1 WEND IF I > J THEN EXIT DO IF I < J THEN SWAP Index(I), Index(J) IF Temp = I THEN Temp = J ELSEIF Temp = J THEN Temp = I END IF END IF I = I + 1 J = J - 1 LOOP WHILE I <= J IF I < Last THEN QStack(StackPtr) = I 'Push I QStack(StackPtr + 1) = Last 'Push Last StackPtr = StackPtr + 2 END IF Last = J LOOP WHILE First < Last IF StackPtr = 0 THEN EXIT DO 'Done StackPtr = StackPtr - 2 First = QStack(StackPtr) 'Pop First Last = QStack(StackPtr + 1) 'Pop Last LOOP ERASE QStack 'delete the stack array END SUB As with TypeSort, TypeISort is entirely pointer based so it can be used with any type of data and it can sort multiple contiguous keys. The only real difference is the addition of the Index() array parameter, and the extra level of indirection needed to access the index array each time a comparison is made. Also, when a swap is required, only the integer index elements are exchanged, which simplifies the code and reduces its size. Like TypeSort, you can change the sort direction by reversing the -1 and 1 values used with Compare3, or add a Direction parameter to the list and modify the code to use that. As with BubbleISort, the index array is initialized to increasing values by the calling program; however, here the first element is set to hold a value of 0 instead of 1. This reduces the calculations needed within the routine each time an address must be obtained. Therefore, when TypeISort returns, the caller must add 1 to the element number held in each index element. This is shown within the FOR/NEXT loop that displays the sorted results. SORTING FILES With the development of TypeISort complete, we can now use that routine to sort disk files. The sorting strategy will be to determine how many records are in the file, to determine how many separate passes are needed to process the entire file. TypeISort and TypeSort are restricted to working with arrays no larger than 64K (32K in the editing environment), so there is a limit as to how much data may be loaded into memory at one time. These sort routines can accommodate more data when compiled because address calculations that result in values larger than 32767 cause an overflow error in the QB editor. This overflow is in fact harmless, and is ignored in a compiled program unless you use the /d switch. Although the routines could be modified to perform segment and address arithmetic to accommodate larger arrays, that still wouldn't solve the problem of having more records than can fit in memory at once. Therefore, separate passes must be used to sort the file contents in sections, with each pass writing a temporary index file to disk. A final merge pass then reads each index to determine which pieces fits where, and then writes the final index file. The program FILESORT.BAS below incorporates all of the sorting techniques shown so far, and includes a few custom BASIC routines to improve its performance. 'FILESORT.BAS, indexed multi-key random access file sort DEFINT A-Z DECLARE FUNCTION Compare3% (BYVAL Seg1, BYVAL Adr1, BYVAL Seg2, _ BYVAL Adr2, NumBytes) DECLARE FUNCTION Exist% (FileSpec$) DECLARE SUB DOSInt (Registers AS ANY) DECLARE SUB FileSort (FileName$, NDXName$, RecLength, Offset, KeySize) DECLARE SUB LoadFile (FileNum, Segment, Address, Bytes&) DECLARE SUB SaveFile (FileNum, Segment, Address, Bytes&) DECLARE SUB SwapMem (BYVAL Seg1, BYVAL Adr1, BYVAL Seg2, BYVAL Adr2, _ BYVAL Length) DECLARE SUB TypeISort (Segment, Address, ElSize, Offset, KeySize, _ NumEls, Index()) RANDOMIZE TIMER 'create new data each run DEF FnRand% = INT(RND * 10 + 1) 'returns RND from 1 to 10 TYPE RegType 'used by DOSInt AX AS INTEGER BX AS INTEGER CX AS INTEGER DX AS INTEGER BP AS INTEGER SI AS INTEGER DI AS INTEGER FL AS INTEGER DS AS INTEGER ES AS INTEGER END TYPE DIM SHARED Registers AS RegType 'share among all subs REDIM LastNames$(1 TO 10) 'we'll select names at REDIM FirstNames$(1 TO 10) ' random from these NumRecords = 2988 'how many test records to use FileName$ = "TEST.DAT" 'really original, eh? NDXName$ = "TEST.NDX" 'this is the index file name TYPE RecType LastName AS STRING * 11 FirstName AS STRING * 10 Dollars AS STRING * 6 Cents AS STRING * 2 AnyNumber AS LONG 'this shows that only key OtherNum AS LONG ' information must be ASCII END TYPE FOR X = 1 TO 10 'read the possible last names READ LastNames$(X) NEXT FOR X = 1 TO 10 'and the possible first names READ FirstNames$(X) NEXT DIM RecordVar AS RecType 'to create the sample file RecLength = LEN(RecordVar) 'the length of each record CLS PRINT "Creating a test file..." IF Exist%(FileName$) THEN 'if there's an existing file KILL FileName$ 'kill the old data from prior END IF ' runs to start fresh IF Exist%(NDXName$) THEN 'same for any old index file KILL NDXName$ END IF '---- Create some test data and write it to the file OPEN FileName$ FOR RANDOM AS #1 LEN = RecLength FOR X = 1 TO NumRecords RecordVar.LastName = LastNames$(FnRand%) RecordVar.FirstName = FirstNames$(FnRand%) Amount$ = STR$(RND * 10000) Dot = INSTR(Amount$, ".") IF Dot THEN RSET RecordVar.Dollars = LEFT$(Amount$, Dot - 1) RecordVar.Cents = LEFT$(MID$(Amount$, Dot + 1) + "00", 2) ELSE RSET RecordVar.Dollars = Amount$ RecordVar.Cents = "00" END IF RecordVar.AnyNumber = X PUT #1, , RecordVar NEXT CLOSE '----- Created a sorted index based on the main data file Offset = 1 'start sorting with LastName KeySize = 29 'sort based on first 4 fields PRINT "Sorting..." CALL FileSort(FileName$, NDXName$, RecLength, Offset, KeySize) '----- Display the results CLS VIEW PRINT 1 TO 24 LOCATE 25, 1 COLOR 15 PRINT "Press any key to pause/resume"; COLOR 7 LOCATE 1, 1 OPEN FileName$ FOR RANDOM AS #1 LEN = RecLength OPEN NDXName$ FOR BINARY AS #2 FOR X = 1 TO NumRecords GET #2, , ThisRecord 'get next rec. number GET #1, ThisRecord, RecordVar 'then the actual data PRINT RecordVar.LastName; 'print each field PRINT RecordVar.FirstName; PRINT RecordVar.Dollars; "."; PRINT RecordVar.Cents IF LEN(INKEY$) THEN 'pause on a keypress WHILE LEN(INKEY$) = 0: WEND END IF NEXT CLOSE VIEW PRINT 1 TO 24 'restore the screen END DATA Smith, Cramer, Malin, Munro, Passarelli DATA Bly, Osborn, Pagliaro, Garcia, Winer DATA John, Phil, Paul, Anne, Jacki DATA Patricia, Ethan, Donald, Tami, Elli END FUNCTION Exist% (Spec$) STATIC 'reports if a file exists DIM DTA AS STRING * 44 'the work area for DOS DIM LocalSpec AS STRING * 60 'guarantee the spec is in LocalSpec$ = Spec$ + CHR$(0) ' DGROUP for BASIC PDS Exist% = -1 'assume true for now Registers.AX = &H1A00 'assign DTA service Registers.DX = VARPTR(DTA) 'show DOS where to place it Registers.DS = VARSEG(DTA) CALL DOSInt(Registers) Registers.AX = &H4E00 'find first matching file Registers.CX = 39 'any file attribute okay Registers.DX = VARPTR(LocalSpec) Registers.DS = VARSEG(LocalSpec) CALL DOSInt(Registers) 'see if there's a match IF Registers.FL AND 1 THEN 'if the Carry flag is set Exist% = 0 ' there were no matches END IF END FUNCTION SUB FileSort (FileName$, NDXName$, RecLength, Displace, KeySize) STATIC CONST BufSize% = 32767 'holds the data being sorted Offset = Displace - 1 'make zero-based for speed later '----- Open the main data file FileNum = FREEFILE OPEN FileName$ FOR BINARY AS #FileNum '----- Calculate the important values we'll need NumRecords = LOF(FileNum) \ RecLength RecsPerPass = BufSize% \ RecLength IF RecsPerPass > NumRecords THEN RecsPerPass = NumRecords NumPasses = (NumRecords \ RecsPerPass) - ((NumRecords MOD RecsPerPass) _ <> 0) IF NumPasses = 1 THEN RecsLastPass = RecsPerPass ELSE RecsLastPass = NumRecords MOD RecsPerPass END IF '----- Create the buffer and index sorting arrays REDIM Buffer(1 TO 1) AS STRING * BufSize REDIM Index(1 TO RecsPerPass) IndexAdjust = 1 '----- Process all of the records in manageable groups FOR X = 1 TO NumPasses IF X < NumPasses THEN 'if not the last pass RecsThisPass = RecsPerPass 'do the full complement ELSE 'the last pass may have RecsThisPass = RecsLastPass ' fewer records to do END IF FOR Y = 1 TO RecsThisPass 'initialize the index Index(Y) = Y - 1 'starting with value of 0 NEXT '----- Load a portion of the main data file Segment = VARSEG(Buffer(1)) 'show where the buffer is CALL LoadFile(FileNum, Segment, Zero, RecsThisPass * CLNG(RecLength)) CALL TypeISort(Segment, Zero, RecLength, Displace, KeySize, _ RecsThisPass, Index()) '----- Adjust the zero-based index to record numbers FOR Y = 1 TO RecsThisPass Index(Y) = Index(Y) + IndexAdjust NEXT '----- Save the index file for this pass TempNum = FREEFILE OPEN "$$PASS." + LTRIM$(STR$(X)) FOR OUTPUT AS #TempNum CALL SaveFile(TempNum, VARSEG(Index(1)), Zero, RecsThisPass * 2&) CLOSE #TempNum '----- The next group of record numbers start this much higher IndexAdjust = IndexAdjust + RecsThisPass NEXT ERASE Buffer, Index 'free up the memory '----- Do a final merge pass if necessary IF NumPasses > 1 THEN NDXNumber = FREEFILE OPEN NDXName$ FOR BINARY AS #NDXNumber REDIM FileNums(NumPasses) 'this holds the file numbers REDIM RecordNums(NumPasses) 'this holds record numbers REDIM MainRec$(1 TO NumPasses) 'holds main record data REDIM Remaining(1 TO NumPasses) 'tracks index files '----- Open the files and seed the first round of data FOR X = 1 TO NumPasses FileNums(X) = FREEFILE OPEN "$$PASS." + LTRIM$(STR$(X)) FOR BINARY AS #FileNums(X) Remaining(X) = LOF(FileNums(X)) 'this is what remains MainRec$(X) = SPACE$(RecLength) 'holds main data file GET #FileNums(X), , RecordNums(X) 'get the next record number RecOffset& = (RecordNums(X) - 1) * CLNG(RecLength) + 1 GET #FileNum, RecOffset&, MainRec$(X) 'then get the data NEXT FOR X = 1 TO NumRecords Lowest = 1 'assume this is the lowest data in the group WHILE Remaining(Lowest) = 0 'Lowest can't refer to a dead index Lowest = Lowest + 1 'so seek to the next higher active index WEND FOR Y = 2 TO NumPasses 'now seek out the truly lowest element IF Remaining(Y) THEN 'consider only active indexes IF Compare3%(SSEG(MainRec$(Y)), _ '<-- use VARSEG with QB SADD(MainRec$(Y)) + Offset, _ SSEG(MainRec$(Lowest)), _ '<-- use VARSEG with QB SADD(MainRec$(Lowest)) + Offset, KeySize) = -1 THEN Lowest = Y END IF END IF NEXT PUT #NDXNumber, , RecordNums(Lowest) 'write the main index Remaining(Lowest) = Remaining(Lowest) - 2 IF Remaining(Lowest) THEN 'if the index is still active GET #FileNums(Lowest), , RecordNums(Lowest) RecOffset& = (RecordNums(Lowest) - 1) * CLNG(RecLength) + 1 GET #FileNum, RecOffset&, MainRec$(Lowest) END IF NEXT ELSE '----- Only one pass was needed so simply rename the index file NAME "$$PASS.1" AS NDXName$ END IF CLOSE 'close all open files IF Exist%("$$PASS.*") THEN 'ensure there's a file to kill KILL "$$PASS.*" 'kill the work files END IF ERASE FileNums, RecordNums 'erase the work arrays ERASE MainRec$, Remaining END SUB SUB LoadFile (FileNum, Segment, Address, Bytes&) STATIC IF Bytes& > 32767 THEN Bytes& = Bytes& - 65536 Registers.AX = &H3F00 'read from file service Registers.BX = FILEATTR(FileNum, 2) 'get the DOS handle Registers.CX = Bytes& 'how many bytes to load Registers.DX = Address 'and at what address Registers.DS = Segment 'and at what segment CALL DOSInt(Registers) END SUB SUB SaveFile (FileNum, Segment, Address, Bytes&) STATIC IF Bytes& > 32767 THEN Bytes& = Bytes& - 65536 Registers.AX = &H4000 'write to file service Registers.BX = FILEATTR(FileNum, 2) 'get the DOS handle Registers.CX = Bytes& 'how many bytes to load Registers.DX = Address 'and at what address Registers.DS = Segment 'and at what segment CALL DOSInt(Registers) END SUB SUB TypeISort (....) STATIC 'as shown in TYPISORT.BAS END SUB FILESORT.BAS begins by defining a function that returns a random number between 1 and 10. Although the earlier sort demonstrations simply read the test data from DATA statements, that is impractical when creating thousands of records. Instead, two arrays are filled--one with ten last names and another with ten first names--and these names are drawn from at random. The Registers TYPE variable that is defined is used by three of the supporting routines in this program. RegType is normally associated with CALL Interrupt and InterruptX, but I have written a small-code replacement to mimic InterruptX that works with DOS Interrupt &H21 only. DOSInt accepts just a single Registers argument, instead of the three parameters that BASIC's Interrupt and InterruptX require. Besides adding less code each time it is used, the routine itself is smaller and simpler than InterruptX. The remainder of the demonstration program should be easy to follow, so I won't belabor its operation; the real action is in the FileSort subprogram. Like TypeSort and TypeISort, FileSort is entirely pointer based, to accommodate TYPE elements of any size and structure. You provide the name of the main data file to be sorted, the name of an index file to create, and the length and offset of the keys within the disk records. The Displace parameter tells how far into the TYPE structure the key information is located. When calling TypeISort this value is should be one-based, but in the final merge pass where Compare3 is used, a zero-based number is required. Therefore, a copy is made (Offset = Displace - 1) near the beginning of the routine. This way, both are available quickly without having to calculate - 1 repeatedly slowing its operation. The initial steps FileSort performs are to determine how many records are in the data file, and from that how many records can fit into memory at one time. Once these are known, the number of passes necessary can be easily calculated. An extra step is needed to ensure that RecsPerPass is not greater than the number of records in the file. Just because 200 records can fit into memory at once doesn't mean there are that many records. In most cases where multiple passes are needed the last pass will process fewer records than the others. If there are, say, 700 records and each pass can sort 300, the last pass will sort only 100 records. Once the pass information is determined, a block of memory is created to hold each portion of the file for sorting. This is the purpose of the Buffer array. REDIM is used to create a 32K chunk of memory that doesn't impinge on available string space. For each pass that is needed, the number of records in the current pass is determined and the index array is initialized to increasing values. Then, a portion of the main data file is read using the LoadFile subprogram. BASIC does not allow you to read records from a random access file directly into a buffer specified by its address. And even if it did, we can load data much faster than pure BASIC by reading a number of records all at once. Once the current block of records has been loaded, TypeISort is called to sort the index array. The index array is also saved very quickly using SaveFile, which is the compliment to LoadFile. A unique name is given to each temporary index file such that the first one is named $$PASS.1, the second $$PASS.2, and so forth. By using dollar signs in the name it is unlikely that the routine will overwrite an existing file from another application. Of course, you may change the names to anything else if you prefer. Notice the extra step that manipulates the IndexAdjust variable. This adjustment is needed because each sort pass returns the index array holding record numbers starting at 0. The first time through, 1 must be added to each element to reflect BASIC's use of record numbers that start at 1. If the first pass sorts, say, 250 records, then the index values 1 through 250 are saved to disk. But the second pass is processing records 251 through 500, so an adjustment value of 251 must be added to each element prior to writing it to disk. If the data file is small and only one pass was needed, the $$PASS.1 file is simply renamed to whatever the caller specified. Otherwise, a merge pass is needed to determine which record number is the next in sequence based on the results of each pass. Believe it or not, this is the trickiest portion of the entire program. For the sake of discussion, we'll assume that four passes were required to sort the file. Each of the four index files contains a sequence of record numbers, and all of the records within that sequence are in sorted order. However, there is no relationship between the data records identified in one index file and those in another. Thus, each index file and corresponding data record must be read in turn. A FOR/NEXT loop then compares each of the four records, to see which is truly next in the final sequence. The complication arises as the merge nears completion, because some of the indexes will have become exhausted. This possibility is handled by the Remaining array. Elements in the Remaining array are initialized to the length of each index file as the indexes are opened. Then, as each index entry is read from disk, the corresponding element is decremented by two to show that another record number was read. Therefore, the current Remaining element must be checked to see if that index has been exhausted. Otherwise, data that was already processed might be considered in the merge comparisons. The final steps are to close all the open files, delete the temporary index files, and erase the work arrays to free the memory they occupied. One important point to observe is the use of SSEG to show Compare3 where the MainRec$ elements are located. SSEG is for BASIC 7 only; if you are using QuickBASIC you must change SSEG to VARSEG. SSEG can be used with either near or far strings in BASIC 7, but VARSEG works with near strings only. SSEG is used as the default, so an error will be reported if you are using QuickBASIC. The cursor will then be placed near the comment in the program that shows the appropriate correction. SEARCHING FUNDAMENTALS ====================== As with sorting, searching data effectively also requires that you select an appropriate algorithm. There are many ways to search data, and we will look at several methods here. The easiest to understand is a linear search, which simply examines each item in sequence until a match is found: FoundAt = 0 'assume no match FOR X = 1 TO NumElements 'search all elements IF Array$(X) = Sought$ THEN FoundAt = X 'remember where it is EXIT FOR 'no need to continue END IF NEXT IF FoundAt THEN 'if it was found PRINT "Found at element"; FoundAt ELSE PRINT "Not found" 'otherwise END IF For small arrays a linear search is effective and usually fast enough. Also, integer and long integer arrays can be searched reasonably quickly even if there are many elements. But with string data, as the number of elements that must be searched increases, the search time can quickly become unacceptable. This is particularly true when additional features are required such as searching without regard to capitalization or comparing only a portion of each element using MID$. Indeed, many of the same techniques that enhance a sort routine can also be employed when searching. To search ignoring capitalization you would first capitalize Sought$ outside of the loop, and then use UCASE$ with each element in the comparisons. Using UCASE$(Sought$) repeatedly within the loop is both wasteful and unnecessary: Sought$ = UCASE$(Sought$) . . IF UCASE$(Array$(X)) = Sought$ THEN Likewise, comparing only a portion of each string will require MID$ with each comparison, after using MID$ initially to extract what is needed from Sought$: Sought$ = MID$(Sought$, 12, 6) . . IF MID$(Array$(X), 12, 6) = Sought$ THEN And again, as with sorting, these changes may be combined in a variety of ways. You could even use INSTR to see if the string being searched for is within the array, when an exact match is not needed: IF INSTR(UCASE$(Array$(X)), Sought$) THEN However, each additional BASIC function you use will make the searching slower and slower. Although BASIC's INSTR is very fast, adding UCASE$ to each comparison as shown above slows the overall process considerably. There are three primary ways that searching can be speeded up. One is to apply simple improvements based on understanding how BASIC works, and knowing which commands are fastest. The other is to select a better algorithm. The third is to translate selected portions of the search routine into assembly language. I will use all three of these techniques here, starting with enhancements to the linear search, and culminating with a very fast binary search for use with sorted data. One of the slowest operations that BASIC performs is comparing strings. For each string, its descriptor address must be loaded and passed to the comparison routine. That routine must then obtain the actual data address, and examine each byte in both strings until one of the characters is different, or it determines that both strings are the same. As I mentioned earlier, if one or both of the strings are fixed-length, then copies also must be made before the comparison can be performed. There is another service that the string comparison routine must perform, which is probably not obvious to most programmers and which also impacts its speed. BASIC frequently creates and then deletes temporary strings without your knowing it. One example is the copy it makes of fixed-length strings before comparing them. But there are other, more subtle situations in which this can happen. For example, when you use IF X$ + Y$ > Z$ BASIC must create a temporary string comprised of X$ + Y$, and then pass that to the comparison routine. Therefore, that routine is also responsible for determining if the incoming string is a temporary copy, and deleting it if so. In fact, all of BASIC's internal routines that accept string arguments are required to do this. Therefore, one good way to speed searching of conventional (not fixed- length) string arrays is to first compare the lengths. Since strings whose lengths are different can't possibly be the same, this will quickly weed those out. BASIC's LEN function is much faster than its string compare routine, and it offers a simple but effective opportunity to speed things up. LEN is made even faster because it requires only a single argument, as opposed to the two required for the comparison routine. SLen = LEN(Sought$) 'do this once outside the loop FOR X = 1 TO NumElements IF LEN(Array$(X)) = SLen THEN 'maybe... IF Array$(X) = Sought$ THEN 'found it! FoundAt = X EXIT FOR END IF END IF NEXT Similarly, if the first characters are not the same then the strings can't match either. Like LEN, BASIC's ASC is much faster than the full string comparison routine, and it too can improve search time by eliminating elements that can't possibly match. Depending on the type and distribution of the data in the array, using both LEN and ASCII can result in a very fast linear search: SLen = LEN(Sought$) SAsc = ASC(Sought$) FOR X = 1 TO NumElements IF LEN(Array$(X)) = SLen THEN IF ASC(Array$(X)) = SAsc THEN IF Array$(X) = Sought$ THEN ... END IF END IF END IF NEXT Notice that the LEN test must always be before the ASC test, to avoid an "Illegal function call" error if the array element is a null string. If all or most of the strings are the same length, then LEN will not be helpful, and ASC should be used alone. As I mentioned before, when comparing fixed-length string arrays BASIC makes a copy of each element into a conventional string, prior to calling its comparison routine. This copying is also performed when using ASC is used, but not LEN. After all, the length of a fixed-length never changes, and BASIC is smart enough to know the length directly. But then, comparing the lengths of these string is pointless anyway. Because of the added overhead to make these copies, the performance of a conventional linear search for fixed-length data is generally quite poor. This is a shame, because fixed-length strings are often the only choice when as much data as possible must be kept in memory at once. And fixed- length strings lend themselves perfectly to names and addresses. It should be apparent by now that the best solution for quickly comparing fixed- length string arrays--and the string portion of TYPE arrays too--is with the various Compare functions already shown. If you are searching for an exact match, then either Compare or Compare2 will be ideal, depending on whether you want to ignore capitalization. If you have only a single string element in each array, you should define a dummy TYPE. This avoids the overhead of having to use both VARSEG and VARPTR as separate arguments. The short example program and SearchType functions that follow search a fixed-length string array for a match. DEFINT A-Z DECLARE FUNCTION Compare% (SEG Type1 AS ANY, SEG Type2 AS ANY, NumBytes) DECLARE FUNCTION Compare2% (SEG Type1 AS ANY, SEG Type2 AS ANY, NumBytes) DECLARE FUNCTION SearchType% (Array() AS ANY, Sought AS ANY) DECLARE FUNCTION SearchType2% (Array() AS ANY, Sought AS ANY) DECLARE FUNCTION SearchType3% (Array() AS ANY, Searched AS ANY) CLS TYPE FLen 'this lets us use SEG LastName AS STRING * 15 END TYPE REDIM Array(1 TO 4000) AS FLen '4000 is a lot of names DIM Search AS FLen 'best comparing like data FOR X = 1 TO 4000 STEP 2 'impart some realism Array(X).LastName = "Henderson" NEXT Array(4000).LastName = "Henson" 'almost at the end Search.LastName = "Henson" 'find the same name '----- first time how long it takes using Compare Start! = TIMER 'start timing FOR X = 1 TO 5 'search five times FoundAt = SearchType%(Array(), Search) NEXT IF FoundAt >= 0 THEN PRINT "Found at element"; FoundAt ELSE PRINT "Not found" END IF Done! = TIMER PRINT USING "##.## seconds with Compare"; Done! - Start! PRINT '----- then time how long it takes using Compare2 Start! = TIMER 'start timing FOR X = 1 TO 5 'as above FoundAt = SearchType2%(Array(), Search) NEXT IF FoundAt >= 0 THEN PRINT "Found at element"; FoundAt ELSE PRINT "Not found" END IF Done! = TIMER PRINT USING "##.## seconds with Compare2"; Done! - Start! PRINT '---- finally, time how long it takes using pure BASIC Start! = TIMER FOR X = 1 TO 5 FoundAt = SearchType3%(Array(), Search) NEXT IF FoundAt >= 0 THEN PRINT "Found at element"; FoundAt ELSE PRINT "Not found" END IF Done! = TIMER PRINT USING "##.## seconds using BASIC"; Done! - Start! END FUNCTION SearchType% (Array() AS FLen, Sought AS FLen) STATIC SearchType% = -1 'assume not found FOR X = LBOUND(Array) TO UBOUND(Array) IF Compare%(Array(X), Sought, LEN(Sought)) THEN SearchType% = X 'save where it was found EXIT FOR 'and skip what remains END IF NEXT END FUNCTION FUNCTION SearchType2% (Array() AS FLen, Sought AS FLen) STATIC SearchType2% = -1 'assume not found FOR X = LBOUND(Array) TO UBOUND(Array) IF Compare2%(Array(X), Sought, LEN(Sought)) THEN SearchType2% = X 'save where it was found EXIT FOR 'and skip what remains END IF NEXT END FUNCTION FUNCTION SearchType3% (Array() AS FLen, Searched AS FLen) STATIC SearchType3% = -1 'assume not found FOR X = LBOUND(Array) TO UBOUND(Array) IF Array(X).LastName = Searched.LastName THEN SearchType3% = X 'save where it was found EXIT FOR 'and skip what remains END IF NEXT END FUNCTION When you run this program it will be apparent that the SearchType function is the fastest, because it uses Compare which doesn't perform any case conversions. SearchType2 is only slightly slower with that added overhead, and the purely BASIC function, SearchType3, lags far behind at half the speed. Note that the array is searched five times in succession, to minimize the slight errors TIMER imposes. Longer timings are generally more accurate than short ones, because of the 1/18th second resolution of the PC's system timer. BINARY SEARCHES This is about as far as we can go using linear searching, and to achieve higher performance requires a better algorithm. The Binary Search is one of the fastest available; however, it requires the data to already be in sorted order. A Binary Search can also be used with a sorted index, and both methods will be described. Binary searches are very fast, and also very simple to understand. Unlike the Quick Sort algorithm which achieves great efficiency at the expense of being complicated, a Binary Search can be written using only a few lines of code. The strategy is to start the search at the middle of the array. If the value of that element value is less than that of the data being sought, a new halfway point is checked and the process repeated. This way, the routine can quickly zero in on the value being searched for. Figure 8-3 below shows how this works. 13: Zambia 12: Sweden 11: Peru 10: Mexico <-- step 2 9: Holland 8: Germany 7: Finland <-- step 1 6: England 5: Denmark 4: China 3: Canada 2: Austria 1: Australia Figure 8-3: How a Binary Search locates data in a sorted array. If you are searching for Mexico, the first element examined is number 7, which is halfway through the array. Comparing Mexico to Finland shows that Mexico is greater, so the distance is again cut in half. In this case, a match was found after only two tries--remarkably faster than a linear search that would have required ten comparisons. Even when huge arrays must be searched, data can often be found in a dozen or so tries. One interesting property of a binary search is that it takes no longer to find the last element in the array than the first one. The program below shows one way to implement a Binary Search. DEFINT A-Z DECLARE FUNCTION BinarySearch% (Array$(), Find$) CLS PRINT "Creating test data..." REDIM Array$(1 TO 1000) 'create a "sorted" array FOR X = 1 TO 1000 Array$(X) = "String " + RIGHT$("000" + LTRIM$(STR$(X)), 4) NEXT PRINT "Searching array..." FoundAt = BinarySearch%(Array$(), "String 0987") IF FoundAt >= 0 THEN PRINT "Found at element"; FoundAt ELSE PRINT "Not found" END IF END FUNCTION BinarySearch% (Array$(), Find$) STATIC BinarySearch% = -1 'no matching element yet Min = LBOUND(Array$) 'start at first element Max = UBOUND(Array$) 'consider through last DO Try = (Max + Min) \ 2 'start testing in middle IF Array$(Try) = Find$ THEN 'found it! BinarySearch% = Try 'return matching element EXIT DO 'all done END IF IF Array$(Try) > Find$ THEN 'too high, cut in half Max = Try - 1 ELSE Min = Try + 1 'too low, cut other way END IF LOOP WHILE Max >= Min END FUNCTION The BinarySearch function returns either the element number where a match was found, or -1 if the search string was not found. Not using a value of zero to indicate failure lets you use arrays that start with element number 0. As you can see, the simplicity of this algorithm belies its incredible efficiency. The only real problem is that the data must already be in sorted order. Also notice that two string comparisons must be made--one to see if the strings are equal, and another to see if the current element is too high. Although you could use Compare3 which examines the strings once and tells if the data is the same or which is greater, a Binary Search is so fast that this probably isn't worth the added trouble. As you will see when you run the test program, it takes far longer to create the data than to search it! Besides the usual enhancements that can be applied to the comparisons using UCASE$ or MID$, this function could also be structured to use a parallel index array. Assuming the data is not sorted but the index array is, the modified Binary Search would look like this: FUNCTION BinaryISearch% (Array$(), Index(), Find$) STATIC BinaryISearch% = -1 'assume not found Min = LBOUND(Array$) 'start at first element Max = UBOUND(Array$) 'consider through last DO Try = (Max + Min) \ 2 'start testing in middle IF Array$(Index(Try)) = Find$ THEN 'found it! BinaryISearch% = Try 'return matching element EXIT DO 'all done END IF IF Array$(Index(Try)) > Find$ THEN 'too high, cut Max = Try - 1 ELSE Min = Try + 1 'too low, cut other way END IF LOOP WHILE Max >= Min END FUNCTION NUMERIC ARRAYS All of the searching techniques considered so far have addressed string data. In most cases, string array searches are the ones that will benefit the most from improved techniques. As you have already seen, BASIC makes copies of fixed-length strings before comparing them, which slows down searching. And the very nature of strings implies that many bytes may have to be compared before determining if they are equal or which string is greater. In most cases, searching a numeric array is fast enough without requiring any added effort, especially when the data is integer or long integer. However, a few aspects of numeric searching are worth mentioning here. One is avoiding the inevitable rounding errors that are sure to creep into the numbers you are examining. Another is that in many cases, you may not be looking for an exact match. For example, you may need to find the first element that is higher than a given value, or perhaps determine the smallest value in an array. Unlike strings that are either the same or they aren't, the binary representation of numeric values is not always so precise. Consider the following test which *should* result in a match, but doesn't. Value! = 1! Result! = 2! CLS FOR X = 1 TO 1000 Value! = Value! + .001 NEXT IF Value! = Result! THEN PRINT "They are equal" ELSE PRINT "Value! ="; Value! PRINT "Result! ="; Result! END IF After adding .001 to Value! 1000 times Value! should be equal to 2, but instead it is slightly higher. This is because the binary storage method used by computers simply cannot represent every possible value with absolute accuracy. Even changing all of the single precision exclamation points (!) to double precision pound signs (#) will not solve the problem. Therefore, to find a given value in a numeric array can require some extra trickery. What is really needed is to determine if the numbers are *very close* to each other, as opposed to exactly the same. One way to accomplish this is to subtract the two, and see if the result is very close to zero. This is shown below. Value! = 1! Result! = 2! CLS FOR X = 1 TO 1000 Value! = Value! + .001 NEXT IF ABS(Value! - Result!) < .0001 THEN PRINT "They are equal" ELSE PRINT "Value! ="; Value! PRINT "Result! ="; Result! END IF Here, the absolute value of the difference between the numbers is examined, and if that difference is very small the numbers are assumed to be the same. Unfortunately, the added overhead of subtracting before comparing slows the comparison even further. There is no simple cure for this, and an array search must apply this subtraction to each element that is examined. Another common use for numeric array searches is when determining the largest or smallest value. Many programmers make the common mistake shown below when trying to find the largest value in an array. MaxValue# = 0 FOR X = 1 TO NumElements IF Array#(X) > MaxValue# THEN MaxValue# = Array#(X) Element = X END IF NEXT PRINT "The largest value found is"; MaxValue# PRINT "And it was found at element"; Element The problem with this routine is that it doesn't account for arrays where all of the elements are negative numbers! In that case no element will be greater than the initial MaxValue#, and the routine will incorrectly report zero as the result. The correct method is to obtain the lowest element value, and use that as a starting point: MaxValue# = Array#(1) FOR X = 2 TO NumElements IF Array#(X) > MaxValue# THEN MaxValue# = Array#(X) END IF NEXT PRINT "The largest value found is"; MaxValue# Determining the highest value in an array would be handled similarly, except the greater-than symbol (>) would be replaced with a less-than operator (<). SOUNDEX The final searching technique I will show is Soundex. It is often useful to search for data based on its sound, for example when you do not know how to spell a person's name. Soundex was invented in the 1920's and has been used since then by, among others, the U.S. Census Bureau. A Soundex code is an alpha-numeric representation of the sound of a word, and it is surprisingly accurate despite its simplicity. The classic implementation of Soundex returns a four-character result code. The first character is the same as the first letter of the word, and the other three are numeric digits coded as shown in Figure 8-4. 1 B, F, P, V 2 C, G, J, K, Q, S, X 3 D, T 4 L 5 M, N 6 R Figure 8-4: The Soundex code numbers returned for significant letters of the alphabet. Letters not shown are simply skipped as being statistically insignificant to the sound of the word. In particular, speaking accents often minimize the importance of vowels, and blur their distinction. If the string is short and there are fewer than four digits, the result is simply padded with trailing zeros. One additional rule is that a code digit is never repeated, unless there is an uncoded letter in between. In the listing that follows, two different implementations of Soundex are shown. 'SOUNDEX.BAS, Soundex routines and example DEFINT A-Z DECLARE FUNCTION ASoundex$ (Word$) DECLARE FUNCTION ISoundex% (Word$) CLS DO PRINT "press Enter alone to exit" INPUT "What is the first word"; FWord$ IF LEN(FWord$) = 0 THEN EXIT DO INPUT "What is the second word"; SWord$ PRINT 'Test by alpha-numeric soundex PRINT "Alpha-Numeric Soundex: "; FWord$; " and "; PRINT SWord$; " do "; IF ASoundex$(FWord$) <> ASoundex$(SWord$) THEN PRINT "NOT "; END IF PRINT "sound the same." PRINT 'Test by numeric soundex PRINT " Numeric Soundex: "; FWord$; " and "; PRINT SWord$; " do "; IF ISoundex%(FWord$) <> ISoundex%(SWord$) THEN PRINT "NOT "; END IF PRINT "sound the same." PRINT LOOP END FUNCTION ASoundex$ (InWord$) STATIC Word$ = UCASE$(InWord$) Work$ = LEFT$(Word$, 1) + "000" WkPos = 2 PrevCode = 0 FOR L = 2 TO LEN(Word$) Temp = INSTR("BFPVCGJKQSXZDTLMNR", MID$(Word$, L, 1)) IF Temp THEN Temp = ASC(MID$("111122222222334556", Temp, 1)) IF Temp <> PrevCode THEN MID$(Work$, WkPos) = CHR$(Temp) PrevCode = Temp WkPos = WkPos + 1 IF WkPos > 4 THEN EXIT FOR END IF ELSE PrevCode = 0 END IF NEXT ASoundex$ = Work$ END FUNCTION FUNCTION ISoundex% (InWord$) STATIC Word$ = UCASE$(InWord$) Work$ = "0000" WkPos = 1 PrevCode = 0 FOR L = 1 TO LEN(Word$) Temp = INSTR("BFPVCGJKQSXZDTLMNR", MID$(Word$, L, 1)) IF Temp THEN Temp = ASC(MID$("111122222222334556", Temp, 1)) IF Temp <> PrevCode THEN MID$(Work$, WkPos) = CHR$(Temp) PrevCode = Temp WkPos = WkPos + 1 IF WkPos > 4 THEN EXIT FOR END IF ELSE PrevCode = 0 END IF NEXT ISoundex% = VAL(Work$) END FUNCTION The first function, ASoundex, follows the standard Soundex definition and returns the result as a string. The ISoundex version cheats slightly by coding the first letter as a number, but it returns an integer value instead of a string. Because integer searches are many times faster than string searches, this version will be better when thousands--or even hundreds of thousands--of names must be examined. An additional benefit of the integer-only method is that it allows for variations on the first letter. For example, if you enter Cane and Kane in response to the prompts from SOUNDEX.BAS ASoundex will not recognize the names as sounding alike where ISoundex will. LINKED DATA =========== No discussion of searching and sorting would be complete without a mention of linked lists and other data links. Unlike arrays where all of the elements lie in adjacent memory locations, linked data is useful when data locations may be disjointed. One example is the linked list used by the DOS File Allocation Table (FAT) on every disk. As I described in Chapter 6, the data in each file may be scattered throughout the disk, and only through a linked list can DOS follow the thread from one sector in a file to another. Another example where linked data is useful--and the one we will focus on here--is to keep track of memo fields in a database. A memo field is a field that can store freeform text such as notes about a sales contact or a patient's medical history. Since these fields typically require varying lengths, it is inefficient to reserve space for the longest one possible in the main database file. Therefore, most programs store memo fields in a separate disk file, and use a *pointer field* in the main data file to show where the corresponding memo starts in the dedicated memo file. Similarly, a back pointer adjacent to each memo identifies the record that points to it. This is shown in Figure 8-5 below. ┌────────┬─────────┬─╥────────┬─────────┬──╥───────── MAIN.DAT │LastName│FirstName│1║LastName│FirstName│73║LastNa... └────────┴─────────┴─╨────────┴─────────┴──╨───────── ^ ^ | | pointers into memo file -----+--------------------+ (forward pointers) offsets into --+----------+-------+--------------+ this memo file | | | | 1 73 126 233 ┌──────────┬───────┬──────────────┬─────────┐ MEMO.DAT │1LMemo1 │2LMemo2│3LMemo3 │4LMemo4 │ └──────────┴───────┴──────────────┴─────────┘ ^ ^ ^ ^ | | | | record numbers +----------+-------+--------------+ (back pointers) (L = length of this memo) Figure 8-5: Pointers relate record numbers to memo file offsets and vice versa. Here, the pointer in the main data file record is a long integer that holds the byte offset into the memo file where the corresponding memo text begins. And just before the memo text is an integer record number that shows which record this memo belongs to. (If you anticipate more than 65,535 records a long integer must be used instead.) Thus, these pointers provide links between the two files, and relate the information they contain. When a new record is added to the main file, the memo that goes with it is appended to the end of the memo file. BASIC's LOF function can be used to determine the current end of the memo file, which is then used as the beginning offset for the new memo text. And as the new memo is appended to MEMO.DAT, the first data actually written is the number of the new record in the main data file. The record number back pointer in the memo file is needed to allow memo data to be edited. Since there's no reasonable way to extend memo text when other memo data follows it, most programs simply abandon the old text, and allocate new space at the end of the file. The abandoned text is then marked as such, perhaps by storing a negative value as the record number. Storing a negative version of the abandoned data's length is ideal, because that both identifies the data as obsolete, and also tells how much farther into the file the next memo is located. The idea here is that you would periodically run a memo file maintenance program that compacts the file, thus eliminating the wasted space the abandoned memos occupy. This is similar to the DBPACK.BAS utility shown in Chapter 7, and also similar to the way that BASIC compacts string memory when it becomes full. But when an existing memo is relocated in the memo file, the field in the main data file that points to the memo must also be updated. And that's why the record number back pointer is needed: so the compaction program can know which record in the main file must be updated. The "L" identifier in the memo file in Figure 8-5, shown between the record number and memo text, is a length byte or word that tells how long the text is. If you plan to limit the memo field lengths to 255 or fewer characters, then a single byte is sufficient. Otherwise an integer must be used. An example of code that reads a data record and then its associated memo text is shown below. GET #MainFile, RecNumber, TypeVar MemoOffset& = TypeVar.MemoOff GET #MemoFile, MemoOffset& + 2, MemoLength% Memo$ = SPACE$(MemoLength%) GET #MemoFile, , Memo$ The first step reads a record from the main data file into a TYPE variable, and the second determines where in the memo file the memo text begins. Two is added to that offset in the second GET statement, to skip over the record number back pointer which isn't needed here. Once the length of the memo text is known, a string is assigned to that length, and the actual text is read into it. If you are using long integer record numbers you would of course use MemoOffset& + 4 in the second GET. And if you're using a single byte to hold the memo length you would define a fixed-length string to receive that byte: DIM Temp AS STRING *1 GET #MemoFile, MemoOffset& + 2, Temp MemoLength = ASC(Temp) Since BASIC doesn't offer a byte-sized integer data type, ASC and STR$ can be used to convert between numeric and string formats. ARRAY ELEMENT INSERTION AND DELETION ==================================== The last issue related to array and memory manipulation I want to cover is inserting and deleting elements. If you intend to maintain file indexes or other information in memory and in sorted order, you will need some way to insert a new entry. By the same token, deleting an entry in a database requires that the parallel index entry also be deleted. The most obvious way to insert or delete elements in an array is with a FOR/NEXT loop. The first example below inserts an element, and the second deletes one. '----- Insert an element: Element = 200 InsertValue = 999 FOR X = UBOUND(Array) TO Element + 1 STEP -1 Array(X) = Array(X - 1) NEXT Array(Element) = InsertValue '----- Delete an element: Element = 200 FOR X = Element TO UBOUND(Array) - 1 Array(X) = Array(X + 1) NEXT Array(UBOUND(Array)) = 0 'optionally clear last element For integer, long integer, and fixed-length arrays this is about as efficient as you can get, short of rewriting the code in assembly language. However, with floating point and string arrays the performance is less than ideal. Unless a numeric coprocessor is installed, floating point values are assigned using interrupts and support code in the emulator library. This adds an unnecessary level of complication that also impacts the speed. When strings are assigned the situation is even worse, because of the memory allocation overhead associated with dynamic string management. A better solution for floating point and string arrays is a series of SWAP statements. The short program below benchmarks the speed difference of the two methods, as it inserts an element into a single precision array. REDIM Array(1 TO 500) CLS Element% = 200 InsertValue = 999 Start = TIMER FOR A% = 1 TO 500 FOR X% = UBOUND(Array) TO Element% + 1 STEP -1 Array(X%) = Array(X% - 1) NEXT Array(Element%) = InsertValue NEXT Done = TIMER PRINT USING "##.## seconds when assigning"; Done - Start Start = TIMER FOR A% = 1 TO 500 FOR X% = UBOUND(Array) TO Element% + 1 STEP -1 SWAP Array(X%), Array(X% - 1) NEXT Array(Element%) = InsertValue NEXT Done = TIMER PRINT USING "##.## seconds when swapping"; Done - Start If you run this program in the BASIC environment, the differences may not appear that significant. But when the program is compiled to an executable file, the swapping method is more than four times faster. In fact, you should never compare programming methods using the BASIC editor for exactly this reason. In many cases, the slowness of the interpreting process overshadows significant differences between one approach and another. String arrays also benefit greatly from using SWAP instead of assignments, though the amount of benefit varies depending on the length of the strings. If you modify the previous program to use a string array, also add this loop to initialize the elements: FOR X% = 1 TO 500 Array$(X%) = "String number" + STR$(X) NEXT With BASIC PDS far strings the difference is only slightly less at about three to one, due to the added complexity of far data. Also, SWAP will always be worse than assignments when inserting or deleting elements in a fixed-length string or TYPE array. An assignment merely copies the data from one location to another. SWAP, however, must copy the data in both directions. Understand that when using SWAP with conventional string arrays, the data itself is not exchanged. Rather, the four-byte string descriptors are copied. But because BASIC program modules store string data in different segments, extra work is necessary to determine which descriptor goes with which segment. When near strings are being used, only six bytes are exchanged, regardless of the length of the strings. Four bytes hold the descriptors, and two more store the back pointers. SUMMARY ======= This chapter explained many of the finer points of sorting and searching all types of data in BASIC. It began with sorting concepts using the simple Bubble Sort as a model, and then went on to explain indexed and multi-key sorts. One way to implement a multi-key sort is by aligning the key fields into adjacent TYPE components. While there are some restrictions to this method, it is fairly simple to implement and also very fast. The Quick Sort algorithm was shown, and the SEEQSORT.BAS program on the accompanying disk helps you to understand this complex routine by displaying graphically the progress of the comparisons and exchanges as they are performed. Along the way you saw how a few simple modifications to any string sort routine can be used to sort regardless of capitalization, or based on only a portion of a string element. You also learned that writing a truly general sort routine that can handle any type of data requires dealing exclusively with segment and address pointers. Here, assembly language routines are invaluable for assisting you when performing the necessary comparisons and data exchanges. Although the actual operation of the assembly language routines will be deferred until Chapter 12, such routines may easily be added to a BASIC program using .LIB and .QLB libraries. I mentioned briefly the usefulness of packing and aligning data when possible, as an aid to fast sorting. In particular, dates can be packed to only three bytes in Year/Month/Day order, and other data such as zip codes can be stored in long integers. Because numbers can be compared much faster than strings, this helps the sorting routines operate more quickly. Array searching was also discussed in depth, and both linear and binary search algorithms were shown. As with the sorting routines, searching can also employ UCASE$ and MID$ to search regardless of capitalization, or on only a portion of each array element. Two versions of the Soundex algorithm were given, to let you easily locate names and other data based on how they sound. Besides showing the more traditional searching methods, I presented routines to determine the minimum and maximum values in a numeric array. I also discussed some of the ramifications involved when searching floating point data, to avoid the inevitable rounding errors that might cause a legitimate match to be ignored. Finally, some simple ways to insert and delete elements in both string and numeric arrays were shown. Although making direct assignments in a loop is the most obvious way to do this, BASIC's often-overlooked SWAP command can provide a significant improvement in speed. The next chapter will conclude this section about hands-on programming by showing a variety of program optimization techniques.