Post by B+ on Apr 28, 2018 18:04:22 GMT
For tsh73, bluatigro and all!
I did do it in two other BASIC's, I was so impressed by JB's Word$() function!
Time to bring it back home with shuffle and sort, I had the other tools already posted at the old forum. I wish someone brought up the subject of OOP emulation then!
EDIT: added subroutine descriptions to help explain what they do specially as relates to string "Arrays"
I did do it in two other BASIC's, I was so impressed by JB's Word$() function!
Time to bring it back home with shuffle and sort, I had the other tools already posted at the old forum. I wish someone brought up the subject of OOP emulation then!
'WORD$ tools update with sort.txt
' from 2017-03-02 collect simple effective tools to work with default word$
' and from Word tools.bas 2017-07-02 update from FB work
test$ = "Hi tsh73 and bluatigro! How are you?"
test2$ = "One two three four five six seven eight nine ten eleven twelve two again."
print "Here is unsorted text source string: ";test$
lo = 1
hi = wCnt(test$)
call wQsort test$, lo, hi
print "Here it is sorted: ";test$
print
call wShuffle test$
print "Here it is shuffled: ";test$
print
print
print "Here is a 2nd test:"
print "Here is unsorted text source string: ";test2$
lo = 1
hi = wCnt(test2$)
call wQsort test2$, lo, hi
print "Here it is sorted: ";test2$
print
call wShuffle test2$
print "Here it is shuffled: ";test2$
'this sub substitutes one word for many,
'the word subst$ is one replacement for all words from first to last
'this came in handy when I took my JB EVAL code to FreeBasic
' and QB64 (and built an interpreter thanks to this sub here!)
sub wsSub byref s$, first, last, subst$
wc = wCnt(s$)
for i = 1 to wc
if first <= i and i <= last then 'do this only once!
if subF = 0 then b$ = b$;subst$;" " : subF = 1
else
b$ = b$;word$(s$, i);" "
end if
next
s$ = b$
end sub
'this sub just exchanges one word at p with the word subst$
sub wSub byref s$, p, subst$ 'combine wPut wCut in one round
wc = wCnt(s$)
for i = 1 to wc
if i = p then b$ = b$;subst$;" " else b$ = b$;word$(s$, i);" "
next
s$ = b$
end sub
'this is what makes a string dynamic array like, by being able to insert elements
' insert new element put$ at p and move all other values up one place
sub wPut byref s$, p, put$ 'insert put$ in s$ as p word
wc = wCnt(s$)
for i = 1 to wc
if i = p then b$ = b$;put$;" "
b$ = b$;word$(s$, i);" "
next
s$ = b$
end sub
'this is what makes a string dynamic array like the ability to delete an element
'and move all the other elements down so the "upper bound" is one less
sub wCut byref s$, p
wc = wCnt(s$)
for i = 1 to wc
if i <> p then b$ = b$;word$(s$, i);" "
next
s$ = b$
end sub
' is a word W$ in a string, if yes, where position is, is returned
function wIn(s$, w$) 'first in s$ that matches w$ (no spaces in w$!)
wIn = 0 : wc = wCnt(s$)
for i = 1 to wc
if w$ = word$(s$, i) then wIn = i : exit function
next
end function
' what is the upper bound of our string array? This returns the amount of elements
function wCnt(s$) 'of default space delimited string
while word$(s$, wc + 1) <> "" : wc = wc + 1 : wend
wCnt = wc
end function
' Yes Virginia, You can treat a string like an array! thanks to Word$() function.
' recursive Qsort on string, OK this is going to be a case sensitive sort of sort
'this function assumes s has been thru wPrep
Sub wQsort ByRef A$, lo, hi
'local nleft, nright, pivotV, t
'hints from Rosetta Code
scan
If hi - lo >= 1 Then 'are we there yet?
'not there yet
nleft = lo 'first index of sub array
nright = hi 'last index of sub array
pivotV$ = Word$( A$, ( Int( (hi - lo) / 2 ) + lo + 1 ) ) 'select any element of sub array
While nleft <= nright
scan
While Word$(A$, nleft) < pivotV$
scan
nleft = nleft + 1
Wend
While Word$(A$, nright) > pivotV$
scan
nright = nright - 1
Wend
If nleft <= nright Then
'swap
t$ = Word$(A$, nright)
call wsSub A$, nright, nright, Word$(A$, nleft)
call wsSub A$, nleft, nleft, t$
nleft = nleft + 1
nright = nright - 1
End If
Wend
call wQsort A$, lo, nright
call wQsort A$, nleft, hi
End If
End sub
' This shuffle based on Fisher-Yates or Knuth Method
' as taught me at JB forum when they didn't like the way I was dealing cards ;)
'this function assumes s has been thru wPrep
Sub wShuffle ByRef A$
'local wc, i, r, t
wc = wCnt(A$)
For i = wc To 2 Step -1
scan
r = Int(Rnd(0) * i) + 1
t$ = Word$(A$, i)
call wsSub A$, i, i, Word$(A$, r)
call wsSub A$, r, r, t$
Next
End sub
EDIT: added subroutine descriptions to help explain what they do specially as relates to string "Arrays"
Here is unsorted text source string: Hi tsh73 and bluatigro! How are you?
Here it is sorted: and are bluatigro! Hi How tsh73 you?
Here it is shuffled: are bluatigro! and tsh73 How you? Hi
Here is a 2nd test:
Here is unsorted text source string: One two three four five six seven eight nine ten eleven twelve two again.
Here it is sorted: again. eight eleven five four nine One seven six ten three twelve two two
Here it is shuffled: One two six nine five two twelve ten eleven again. eight four three seven
Here it is sorted: and are bluatigro! Hi How tsh73 you?
Here it is shuffled: are bluatigro! and tsh73 How you? Hi
Here is a 2nd test:
Here is unsorted text source string: One two three four five six seven eight nine ten eleven twelve two again.
Here it is sorted: again. eight eleven five four nine One seven six ten three twelve two two
Here it is shuffled: One two six nine five two twelve ten eleven again. eight four three seven