Mem-QS-BS

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.

If you want to use mixed case here, replace cmptype% = 1 with cmptype% = 0 in any CMP%(str1$, str2$; cmptype%) statement. Alternatively, simply do away with CMP% in all cases where used, and replace with standard Qdos comparison operators.

The real meat of the piece 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. Note that most Quicksort algorithms, including this one, are very fast on unsorted data and very slow on almost sorted data.

The harness is just a simple demo, with no real error checking. As it stands, it is designed to be LRUNed in the standard 3-window S*BASIC console.

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.

10 rem Sort and search strings in memory.
11 rem The harness is just a simple demo. No checking on
12 rem memory limits, etc!
13 rem Requires CMP% and PEEKSTR/POKESTR$
14 :
15 rem     Init memory and index
16 RESTORE
17 adr = ALCHP(512): DIM idx(40)
18 :
19 rem     Set sentinel
20 POKE_W adr, 0: idx(0) = adr
21 pos = adr + 2
22 :
23 rem     Stuff data into memory
24 FOR c = 1 TO DIMN(idx)
25  IF EOF: EXIT c
26  READ str$: POKESTR$ pos, str$
27  idx(c) = pos
28  pos = pos + ((LEN(str$) + 3) && -2):   rem Make next address even
29 END FOR c
30 c = c - 1:                              rem 0..N
31 :
32 rem     Show data
33 FOR i = 0 TO 2: CLS#i
34 FOR i = 1 TO c: PRINT PEEKSTR$(idx(i))
35 :
36 rem     Sort and display sorted data
37 dt = DATE
38 QSort idx(0 TO c)
39 FOR i = 1 TO c: PRINT#2; PEEKSTR$(idx(i))
40 PRINT#0; 'Time taken to sort'! c! 'items:'! DATE - dt; 's'\
41 :
42 REPeat lp
43  INPUT#0; 'Look for'! n$,: IF n$ = '': EXIT lp
44  r% = BSearch%(n$, idx(0 TO c), 0)
45  INK#0; 7
46  IF r% >= 0 THEN
47   PRINT#0; TO 30; r%! PEEKSTR$(idx(r%))
48  ELSE
49   PRINT#0\ TO 30; r%! 'Not found'
50  END IF
51  INK#0; 4
52 END REPeat lp
53 :
54 PRINT#0\\ 'Done!': PAUSE#0: RECHP adr
55 :
56 :
100 rem + ------------------------------------------------------------------------ +
102 rem |<                                BSearch                                 >|
104 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
106 rem |                              Binary Search                               |
108 rem |                                                                          |
110 rem | Returns position if found, or -position where item should go. Thus it    |
112 rem | can be used to add new, unique items to a list, in alphabetical order.   |
114 rem |                                                                          |
116 rem | Keywords: PEEKSTR$ CMP%                                                  |
118 rem + ------------------------------------------------------------------------ +
120 rem | V0.01, From TAOCP 6.2.1                                                  |
122 rem | V0.02, pjw, February 7th 2018, Ints. NF => -pos - 1                      |
124 rem | V0.03, pjw, Seach memory locations. Strings, case independent using CMP% |
126 rem | V0.04, pjw, Tweak: Array starts at 1, to match QSort                     |
128 rem + ------------------------------------------------------------------------ +
130 :
132 DEFine FuNction BSearch%(item, Arr, ofs%)
134 LOCal loop, u%, l%, i%
136 l% = 1: u% = DIMN(Arr)
138 REPeat loop
140  IF u% < l%: RETurn -i%
142  i% = (l% + u%) / 2
144  IF item == PEEKSTR$(Arr(i%) + ofs%): EXIT loop
146  IF CMP%(item, PEEKSTR$(Arr(i%) + ofs%); 1) < 0 THEN
148   u% = i% - 1
150  ELSE
152   l% = i% + 1
154  END IF
156 END REPeat loop
158 RETurn i%
160 END DEFine BSearch%
162 :
164 :
166 rem + ------------------------------------------------------------------------ +
168 rem |<                               Quicksort                                >|
170 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
172 rem | Non-recursive quicksort                                                  |
174 rem | Algorithms R. Sedgewick p110                                             |
176 rem | 100 integers (-100 to 100): QL 6 secs. Already sorted: 21 secs!          |
178 rem | Not stable. Sentinel: min value at array(0)                              |
180 rem |                                                                          |
182 rem | Keywords: PEEKSTR$ CMP%                                                  |
184 rem | Modified: Sorts index into memory location of strings. Each element in   |
186 rem | array points to a qstr in memory. (qstr = QL-type string: Len.w + bytes) |
188 rem | Element 0 => empty str, ie dc.w 0                                        |
190 rem + ------------------------------------------------------------------------ +
192 rem | V0.02, pjw, February 6th 2018                                            |
194 rem + ------------------------------------------------------------------------ +
196 :
198 DEFine PROCedure QSort(Arr)
200 LOCal loop, ii, jj, j%, v$, t
202 LOCal l%, r%
204 LOCal i%, p%, stk%(50)
206 l% = 1: r% = DIMN(Arr): p% = 2: t% = 0
208 REPeat ll
210  IF r% > l% THEN
212   i% = l% - 1: j% = r%: v$ = PEEKSTR$(Arr(r%))
214   REPeat loop
216    REPeat ii: i% = i% + 1: IF CMP%(PEEKSTR$(Arr(i%)), v$; 1) >= 0: EXIT ii
218    REPeat jj: j% = j% - 1: IF CMP%(PEEKSTR$(Arr(j%)), v$; 1) <= 0: EXIT jj
220    t = Arr(i%)
222    IF j% <= i% THEN
224     Arr(i%) = Arr(r%): Arr(r%) = t
226     EXIT loop
228    ELSE
230     Arr(i%) = Arr(j%): Arr(j%) = t
232    END IF
234   END REPeat loop
236   :
238   IF (i% - l%) > (r% - i%) THEN
240    stk%(p%) = l%: stk%(p% + 1) = i% - 1: l% = i% + 1
242   ELSE
244    stk%(p% )= i% + 1: stk%(p% + 1) = r%: r% = i% - 1
246   END IF
248   p% = p% + 2: IF p% > t%: t% = p%
250  ELSE
252   p% = p% - 2: l% = stk%(p%) :r% = stk%(p% + 1)
254  END IF
256  IF p% = 0: EXIT ll
258 END REPeat ll
260 rem PRINT 't% ='! t%
262 END DEFine QSort
264 :
266 :
1000 DATA "baptist"
1001 DATA "hampsters"
1002 DATA "appendices"
1003 DATA "brawlers"
1004 DATA "merriest"
1005 DATA "capitals"
1006 DATA "objectors"
1007 DATA "clothing"
1008 DATA "gleaner"
1009 DATA "devour"
1010 DATA "parallel"
1011 DATA "inflate"
1012 DATA "crannies"
1013 DATA "cyanide"
1014 DATA "oughtn't"
1015 DATA "easterly"
1016 DATA "flopping"
1017 DATA "evermore"
1018 DATA 'zombi'
1019 DATA 'awkward'
  
Generated with sb2htm on 2019 Jul 04
©pjwitte March 2oi9