Download text file
$if 0
QuickSort
A%() array of elements to be sorted
First% first element number in array
Last% last element number in array
NOTE: extreemly fast when the whole array is out of order but
as it is recursive it will require a larger stack
SEE: $STACK
ShellSort
A%() array of elements to be sorted
First% the first element number
Last% the last element number
NOTE: slow sort but will work with a smaller stack and provides
good support for small lists
ZigZagSort
A%() array of elements to be sorted
First% the first element number
Last% the last element number
NOTE: this sort is used when only one element is out of order
but the element number is _NOT_ known
ReSortOne
A%() array of elements to be sorted
First% the first element number
Last% the last element number
Start% the element that is out of oreder
NOTE: this sort is the same as ZigZagSort but the element that
is out of order is known (very fast)
fBinSearch%
A$() array of elements to be searched
Last% the last element to be used
Srch$ the element to be sought
Unique% if TRUE then only elements of A$() that EXACTLY match
Srch$ will be returned
RETURNS: The element number of a match
or ZERO if no elements match Srch$
NOTE: extreemly fast search routine
fBinScan
I$() array to be used
Search$ string to be sought
Test$ string version of the test operand to use eg: "=>"
Start% starting array element
Last% last array element
MidPos% mid string position to start testing at
Units% +1 or -1 to indicate direction of search
$endif
' -----------------------------------------------------------------
' -------------- start of code
' -----------------------------------------------------------------
SUB QuickSort ( SEG I$(), BYVAL First%, BYVAL Last% ) LOCAL PUBLIC
LOCAL F%, L%, H$
F% = First%
L% = Last%
H$ = I$( (F%+L%) \ 2 )
DO
WHILE ( I$(F%) < H$ ) AND ( F% < Last% ) : INCR F% : WEND
WHILE ( I$(L%) > H$ ) AND ( L% > First% ) : DECR L% : WEND
IF F% > L% THEN EXIT LOOP
SWAP I$(F%), I$(L%)
INCR F% : DECR L%
LOOP
IF First% < L% THEN QuickSort I$(), First%, L%
IF F% < Last% THEN QuickSort I$(), F%, Last%
END SUB
' --------------------------------------------------------------
SUB ZigZagSort(A%(),BYVAL First%,BYVAL Last%) LOCAL PUBLIC
LOCAL D%, L%, P1%, P2%
D% = 1 : L% = Last%
WHILE D% = SGN( Last% - First% )
Last% = First%
First% = L% - D%
D% = -D%
FOR P1% = First% TO Last% STEP D%
P2% = P1% + 1
IF A%(P1%) > A%(P2%) THEN
SWAP A%(P1%), A%(P2%)
L% = P1%
END IF
NEXT
WEND
END SUB
' -----------------------------------------------------------------
SUB ReSortOne (A$(),BYVAL First%,BYVAL Last%,BYVAL Start%) LOCAL PUBLIC
LOCAL D%, P1%, P2%
IF ( Start% = Last% ) OR _
( A$(Start% + 1) > A$(Start%) ) THEN
D% = -1 : Last% = First% : DECR Start%
ELSE
D% = 1 : DECR Last%
END IF
FOR P1% = Start% TO Last% STEP D%
P2% = P1% + 1
IF A$(P1%) <= A$(P2%) THEN EXIT SUB
SWAP A$(P1%), A$(P2%)
NEXT
END SUB
' ----------------------------------------------------------------
SUB ShellSort ( A%(), BYVAL First%, BYVAL Last% ) LOCAL PUBLIC
LOCAL H%, I%, F%, M%, L%
H% = ( Last% - First% + 1 ) / 2
WHILE H% > 0
L% = Last% - H%
DO
M% = 0 : F% = First% + H%
FOR I% = First% TO L%
IF A%(I%) > A%(F%) THEN
SWAP A%(I%), A%(F%)
M% = I%
END If
INCR F%
NEXT
L% = ( M% - H% )
LOOP UNTIL M% = 0
H% = H% / 2
WEND
END SUB
' ----------------------------------------------------------------
FUNCTION fBinSearch%(SEG L$(),BYVAL L%,SEG S$,BYVAL U%) LOCAL PUBLIC
LOCAL F%, M%
'Ú---------------
F% = 1 '| start here
DO '| searching
M% = ( F% + L% ) \ 2 '| mid way
IF M% = F% THEN EXIT LOOP '| bingo!
IF S$ =< L$(M%) THEN L% = M% ELSE F% = M% '| which 1/2?
LOOP '|
'|
IF S$ > L$(M%) THEN M% = L% '| past it!
IF (U% = 0) OR (S$ = L$(M%)) THEN FUNCTION = M% '| unique?
'À---------------
END FUNCTION
' -----------------------------------------------------------
FUNCTION fBinScan%( I$(), Search$, Test$, Start%, Last%, MidPos%, Units% ) LOCAL PUBLIC
LOCAL D$, Slen%
Slen% = LEN( Search$ ) '| Search$ = looking for
DO '|
INCR Start%, Units% '| Units% = -1 or +1 etc
IF ( Start% < 1 ) OR _ '| past start/end
( Start% > Last% ) THEN EXIT FUNCTION '|
D$ = MID$( I$(Start%), MidPos%, Slen% ) '| mid-section to search
SELECT CASE Test$ '|
CASE "" : Ok% = -1 '| next one!
CASE "=" : Ok% = ( Search$ = D$ ) '| equals
CASE "=>" : Ok% = ( D$ => Search$ ) '| equal or greater
CASE "=<" : Ok% = ( D$ => Search$ ) '| equal or less
CASE ">" : Ok% = ( D$ > Search$ ) '| greater than
CASE "<" : Ok% = ( D$ < Search$ ) '| less than
CASE "<>" : Ok% = ( Search$ <> D$ ) '| not equal
CASE "[]" : Ok% = INSTR(D$, Search$) '| contains
CASE "][" : Ok% = ( INSTR(D$,Search$)=0) '| does NOT contain
END SELECT '|
LOOP UNTIL Ok% <> 0 '| bingo!
FUNCTION = Start% '| position number
END FUNCTION