|
Post by B+ on Feb 20, 2019 6:41:49 GMT
' Working the following string which happens to be the title of this code. aString$ = "swapping letters in a string by bplus 2019-02-20" LenString = len(aString$)
[restart] scan 'always good to put this in loops in case an error causes an infinite loop
'load an array with all the letters and such dim lettersAndSuch$(LenString) for i = 1 to LenString 'ignore 0 in the array scan 'always good to put this in loops in case an error causes an infinite loop lettersAndSuch$(i) = mid$(aString$, i, 1) next
'now lettersAndSuch$() has each letter and such from aString$ print "Here is aString$ from the lettersAndSuch$() array:" gosub [present_LettersAndSuch_array]
print "OK let's shuffle the letters and display them 5 times:" print for s = 1 to 5 scan 'always good to put this in loops in case an error causes an infinite loop print "#";s;":"; gosub [shuffle] next
print print "If you would like to shuffle a string, enter it now, otherwise press enter " input "";aString$ print LenString = len(aString$) if LenString then goto [restart]
print "Goodbye!" end '==================== don't let execution go past here
'Subroutines
[present_LettersAndSuch_array] print space$(8);"*"; ' start string indented a bit with a starting * for Letter = 1 to LenString scan 'always good to put this in arrays in case an error causes an infinite loop print lettersAndSuch$(Letter); 'print all the letters next to each other next print "*" 'finish off the line with ending * print ' add blank line return
[shuffle] 'Using Fisher-Yates or Knuth Method of Shuffling, tsh73 taught me a few years ago. 'for how many letters there are in aString$ minus 1 swap with another letter in aString$ for L = LenString to 2 step -1 scan 'always good to put this in arrays in case an error causes an infinite loop r = int(rnd(0) * L) + 1 'pick a random number from 1 to L temp$ = lettersAndSuch$(L) 'save the value at L lettersAndSuch$(L) = lettersAndSuch$(r) 'put the value at r into L lettersAndSuch$(r) = temp$ 'put the value that was at L into r next print space$(5);"Here is aString$ shuffled a bit:" gosub [present_LettersAndSuch_array] return
|
|
|
Post by tsh73 on Feb 20, 2019 10:02:46 GMT
LOL
(don't make my ...)
|
|
|
Post by B+ on Feb 23, 2019 16:03:33 GMT
Taking some hints from John's approach (by tossing out an array to serve as temporary containers), here is a much more usable reusable set of functions and demo code than code post above, adding shuffling word function and demos including ones for creating and shuffling a card deck:
'Shuffling characters or words (1 or more chars separated by spaces) in a string B+ 2019-02-23
d$ = "0123456789" print "Shuffle this string of digits: ";d$ for test = 1 to 10 scan print shuffleChars$(d$) next print s50$ = nChars$(35, "A") + nChars$(10, "B") + nChars$(5, "C") print "Shuffle this string of ABC's: " print s50$;", A's ";countChars(s50$, "A");", B's ";countChars(s50$, "B");", C's ";countChars(s50$, "C") print for test = 1 to 10 scan shuffled$ = shuffleChars$(s50$) print shuffled$;", A's ";countChars(shuffled$, "A");", B's ";countChars(shuffled$, "B");", C's ";countChars(shuffled$, "C") next print deck$ = createDeck$() print "Here is unshuffled deck of cards:" call showCardDeck deck$ print print "Here it is shuffled:" sDeck$ = shuffleWords$(deck$) call showCardDeck sDeck$ print print "Here it is shuffled again:" sDeck$ = shuffleWords$(deck$) call showCardDeck sDeck$
' ============================= reuseable Subroutines ====================================
'shuffles the characters in a string function shuffleChars$(s$) 'Using Fisher-Yates or Knuth Method of Shuffling, tsh73 taught me a few years ago. for L = len(s$) to 2 step -1 scan 'always good to put this in loops in case an error causes an infinite loop r = int(rnd(0) * L) + 1 'pick a random number from 1 to L temp$ = mid$(s$, L, 1) 'save the value at L s$ = mid$(s$, 1, L-1) + mid$(s$, r, 1) + mid$(s$, L+1) 'put the value at r into L s$ = mid$(s$, 1, r-1) + temp$ + mid$(s$, r+1) 'put the value that was at L into r next shuffleChars$ = s$ end function
'shuffle words (groups of characters separated by spaces) in a string function shuffleWords$(s$) wc = 0 'count words while word$(s$, wc + 1) <> "" wc = wc + 1 wend
'Using Fisher-Yates or Knuth Method of Shuffling, tsh73 taught me a few years ago. for w = wc to 2 step -1 scan 'always good to put this in loops in case an error causes an infinite loop r = int(rnd(0) * w) + 1 'pick a random number from 1 to w rtemp$ = word$(s$, r) 'swap word at r position wtemp$ = word$(s$, w) 'swap word at w position b$ = "" 'new build for w1 = 1 to wc 'rebuild s$ if w1 <> w and w1 <> r then ' build with same word if len(b$) then b$ = b$ + " " + word$(s$, w1) else b$ = word$(s$, w1) else if w1 = w then ' build with swapped word if len(b$) then b$ = b$ + " " + rtemp$ else b$ = rtemp$ else if len(b$) then b$ = b$ + " " + wtemp$ else b$ = wtemp$ end if end if next s$ = b$ 'reset s to new build with swapped words next shuffleWords$ = s$ end function
'returns a string of n Characters function nChars$(n, Char$) for i = 1 to n b$ = b$ + Char$ next nChars$ = b$ end function
function countChars(s$, Char$) for i = 1 to len(s$) if mid$(s$, i, 1) = Char$ then c = c + 1 next countChars = c end function
function createDeck$() ss$ = " -S -H -C -D" vs$ = "2 3 4 5 6 7 8 9 10 J Q K A" for suit = 1 to 4 for value = 1 to 13 if len(d$) then d$ = d$ + " " + word$(vs$, value) + word$(ss$, suit) else d$ = word$(vs$, value) + word$(ss$, suit) next next createDeck$ = d$ end function
sub showCardDeck dk$ card = 1 for suit = 1 to 4 for value = 1 to 13 if card <> 52 then print word$(dk$, card);", "; else print word$(dk$, card); card = card + 1 next print next end sub
Demo output:
|
|
|
Post by tenochtitlanuk on Feb 23, 2019 18:15:04 GMT
Neat! It's discouraging when OP's don't come back with effusive thanks. But you are contributing lots of useful code... and silent forum-users appreciate it.
|
|
|
Post by B+ on Feb 24, 2019 14:22:34 GMT
Neat! It's discouraging when OP's don't come back with effusive thanks. But you are contributing lots of useful code... and silent forum-users appreciate it. Thanks for your encouragement. Learning programming can be frustrating and exacting but, oh man! what a feeling when it finally comes together and works! I hope to share some of that with others.
|
|