QL Software
This routine demonstrates sorting and searching strings in memory. The strings need not be in contiguous memory locations - as long as their location is recorded in the index, idx.
The pièces de résistance here are the two routines QSort and BSearch. They should be useful in any context where a small number of strings need to be sorted and/or searched in memory. For a BBQL "a small number" is < 100 items.
This is useful where, for example, you may encounter an unknown quantity of strings and/or of widely variable lengths. Rather than DIMention an array of the maximum possible number of elements and the maximum length, use a heap and store the strings consecutively. Should you need more space, add another heap, etc.
Note that most Quicksort algorithms, including this one, are very fast on unsorted data and very slow on almost sorted data. If you merely wish to add a few strings to an already sorted list it is better to use a binary insertion sort for this. You can use the BSearch routine here for that too. Just add an insertion routine to the mix.
The first part of this program is just a simple harness for demonstration purposes. As it stands, it is designed to be LRUNed in the standard 3-window S*BASIC console. On RUNing, it first displays the unordered list of items in the left window then, depending on system, shortly after, the items in order to the right. Finally, you are offered to search for items in the list: Type the name of one of the items in the list - in upper, lower or mixed case - and the routine will print the item as found with its position. If the item is not found the negated position the item would have had in the index array had it been in the list is returned instead.
A space-saving variation of this routine is, instead of using an absolute pointer index, to simply use an integer array of offsets from the heap's base address. Obviously, this would only work where the heap size will be < 32k. Ie perhaps ideal where an unknown, but potentially large, quantity of short strings are expected. In this version, I sacrificed the option to do this on the alter of clarity, but it shouldnt be too hard to add back in if you need it. (See UniqueIndOfs for example.)
Three of my pick'n mix toolkit keywords are used here, POKESTR$, PEEKSTR$ & CMP%, but they could be replaced by S*BASIC or other toolkit equivalents, although CMP% might be hard to replace in the case of mixed case strings..
10 rem + ************************************************************************ + 12 rem *< Mem-QS-BS >* 14 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 16 rem * Sort and search strings in memory. * 18 rem * * 20 rem * The harness is just a simple demo. Basic error checking! * 22 rem * * 24 rem * Requires CMP% and PEEKSTR/POKESTR$ * 26 rem + ------------------------------------------------------------------------ + 28 rem * V0.02, pjw, 2022 May 06 * 30 rem * V0.03, pjw, 2022 Jul 03, fixed bug introduced above * 32 rem + ************************************************************************ + 34 : 36 : 100 rem Init memory and index 102 case = 1: rem Case agnostic = 1, else 0 104 maxm = 512: rem Max heap size 106 maxc = 40: rem Max items (count = 1..40) 108 adr = ALCHP(maxm): DIM idx(maxc) 110 : 112 rem Set sentinel 114 POKE_W adr, 0: idx(0) = adr 116 pos = adr + 2: mem = 2: rem mem = mem used 118 : 120 rem Stuff data into memory 122 RESTORE 124 FOR c = 1 TO DIMN(idx) 126 IF EOF: EXIT c 128 READ str$ 130 sz = ((LEN(str$) + 3) && -2): rem Include length and padding 132 mem = mem + sz 134 IF mem > maxm: PRINT#0; 'Heap full!': EXIT c 136 POKESTR$ pos, str$ 138 idx(c) = pos 140 pos = pos + sz: rem Next position 142 END FOR c 144 c = c - 1: rem 1..N 146 : 148 rem Show data 150 FOR i = 0 TO 2: CLS#i 152 FOR i = 1 TO c: PRINT#2; PEEKSTR$(idx(i)) 154 : 156 rem Sort and display sorted data 158 dt = DATE 160 QSort idx(0 TO c), case 162 FOR i = 1 TO c: PRINT#1; PEEKSTR$(idx(i)) 164 PRINT#0; 'Time taken to sort'! c! 'items:'! DATE - dt; 's'\ 166 : 168 rem Quick search data 170 REPeat lp 172 INPUT#0; 'Look for'! n$,: IF n$ = '': EXIT lp 174 r% = BSearch%(n$, idx(0 TO c), case) 176 INK#0; 7 178 IF r% >= 0 THEN 180 PRINT#0; TO 30; r%! PEEKSTR$(idx(r%)) 182 ELSE 184 PRINT#0\ TO 30; r%! 'Not found' 186 END IF 188 INK#0; 4 190 END REPeat lp 192 : 194 PRINT#0\\ 'Done!': PAUSE: RECHP adr 196 : 198 : 1000 rem + ------------------------------------------------------------------------ + 1002 rem |< BSearch >| 1004 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 1006 rem | Binary Search (string indirect version) | 1008 rem | | 1010 rem | Returns index position if found, or -position where item should go. | 1012 rem | Thus it can be used to add new, unique items to a list, in alphabetical | 1014 rem | order. | 1016 rem | item$ = string to search for | 1018 rem | Arr = array of pointers to items in memory | 1020 rem | cs = case comparison (1 => agnostic, 0 => same) | 1022 rem | Keywords: PEEKSTR$ CMP% | 1024 rem + ------------------------------------------------------------------------ + 1026 rem | V0.01, From TAOCP 6.2.1 | 1028 rem | V0.02, pjw, February 7th 2018, Ints. NF => -pos | 1030 rem | V0.03, pjw, Seach memory locations. Strings, case independent using CMP% | 1032 rem | V0.04, pjw, Tweak: Array starts at 1, to match QSort | 1034 rem | V0.05, pjw, 2022 Jul 03, removed offset, added case parameter, SELect | 1036 rem + ------------------------------------------------------------------------ + 1038 : 1040 DEFine FuNction BSearch%(item$, Arr, cs) 1042 LOCal loop, u%, l%, i%, e% 1044 l% = 1: u% = DIMN(Arr) 1046 REPeat loop 1048 IF u% < l%: RETurn -l%: rem Not found here 1050 i% = INT((l% + u%) / 2) 1052 e% = CMP%(item$, PEEKSTR$(Arr(i%)); cs) 1054 SELect ON e% 1056 = -1: u% = i% - 1: rem < 1058 = 0: EXIT loop: rem = 1060 = 1: l% = i% + 1: rem > 1062 END SELect 1064 END REPeat loop 1066 RETurn i% 1068 END DEFine BSearch% 1070 : 1072 : 1074 rem + ------------------------------------------------------------------------ + 1076 rem |< Quicksort >| 1078 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 1080 rem | Non-recursive quicksort | 1082 rem | | 1084 rem | Algorithms R. Sedgewick p110 (Pascal version) | 1086 rem | Uses a pushdown stack and end-recursion removal. Stack (stk%) require- | 1088 rem | ments set at fixed size here, sufficient for common usage.. | 1090 rem | NB: Not stable. Sentinel: min value at array(0) | 1092 rem | BBQL: 100 integers between -100 and 100: 6s. Already sorted: 21s! | 1094 rem | | 1096 rem | Arr = array of pointers to strings in memory | 1098 rem | cs = case comparison (1 => agnostic, 0 => same) | 1100 rem | | 1102 rem | Modified: Sorts index into memory location of strings. Each element in | 1104 rem | array points to a qstr in memory. (qstr = QL-type string: Len.w + bytes) | 1106 rem | Element 0 => empty str, ie dc.w 0 | 1108 rem | Keywords: PEEKSTR$ CMP% | 1110 rem + ------------------------------------------------------------------------ + 1112 rem | V0.02, pjw, February 6th 2018, external data indirect | 1114 rem | V0.03, pjw, 2022 Jul 03, added case parameter | 1116 rem + ------------------------------------------------------------------------ + 1118 : 1120 DEFine PROCedure QSort(Arr, cs) 1122 LOCal loop, ll, ii, jj, j%, v$, t 1124 LOCal l%, r% 1126 LOCal i%, p%, stk%(50) 1128 l% = 1: r% = DIMN(Arr): p% = 2: t% = 0 1130 REPeat ll 1132 IF r% > l% THEN 1134 i% = l% - 1: j% = r%: v$ = PEEKSTR$(Arr(r%)) 1136 REPeat loop 1138 REPeat ii: i% = i% + 1: IF CMP%(PEEKSTR$(Arr(i%)), v$; cs) >= 0: EXIT ii 1140 REPeat jj: j% = j% - 1: IF CMP%(PEEKSTR$(Arr(j%)), v$; cs) <= 0: EXIT jj 1142 t = Arr(i%) 1144 IF j% <= i% THEN 1146 Arr(i%) = Arr(r%): Arr(r%) = t 1148 EXIT loop 1150 ELSE 1152 Arr(i%) = Arr(j%): Arr(j%) = t 1154 END IF 1156 END REPeat loop 1158 : 1160 IF (i% - l%) > (r% - i%) THEN 1162 stk%(p%) = l%: stk%(p% + 1) = i% - 1: l% = i% + 1 1164 ELSE 1166 stk%(p% )= i% + 1: stk%(p% + 1) = r%: r% = i% - 1 1168 END IF 1170 p% = p% + 2: IF p% > t%: t% = p% 1172 ELSE 1174 p% = p% - 2: l% = stk%(p%) :r% = stk%(p% + 1) 1176 END IF 1178 IF p% = 0: EXIT ll 1180 END REPeat ll 1182 END DEFine QSort 1184 : 1186 : 1188 rem Program Data 1190 DATA "baptist" 1192 DATA "hampsters" 1194 DATA "appendices" 1196 DATA "brawlers" 1198 DATA "merriest" 1200 DATA "capitals" 1202 DATA "objectors" 1204 DATA "clothing" 1206 DATA "gleaner" 1208 DATA "devour" 1210 DATA "parallel" 1212 DATA "inflate" 1214 DATA "crannies" 1216 DATA "cyanide" 1218 DATA "oughtn't" 1220 DATA "easterly" 1222 DATA "flopping" 1224 DATA "evermore" 1226 DATA 'zombi' 1228 DATA 'awkward'
QL Software