Word Scrambler (kind of) Challenge

[Meg]

I'm bored at work, so I decided to post a challenge for you all. I saw the other day this funny quote:

"Aoccdrnig to rseearch at an Elingsh uinervtisy, it deosn't mttaer in waht oredr the ltteers in a wrod are, olny taht the frist and lsat ltteres are at the rghit pcleas. The rset can be a toatl mses and you can sitll raed it wouthit a porbelm. Tihs is bcuseae we do not raed ervey lteter by ilstef, but the wrod as a wlohe."

which is jumbled from:

"According to research at an English university, it doesn't matter in what order the letters in a word are, only that the first and last letters are at the right places. The rest can be a total mess and you can still read it without a problem. This is because we do not read every letter by itself, but the word as a whole."

The challenge is to write a word jumbler function:

FUNCTION Jumble$(InputText$)

which when printed will output the InputText$ in such a way as to scramble up the middle letters of words, but keep the first and last letters--along with any punctuation--the same.

The only characters that will be in InputText$ are numbers, letters (both upper- and lower-case), space, period, exclamation point, question mark, double-quotes, colon, semi-colon, comma, apostrophe, hyphen, ampersand, dollar sign, and open and close parentheses

a-z
A-Z
0-9
, . ? ! $ & ( ) ; : - " '

ONLY letters get jumbled. If you have a word such as abcde-fghij with a hyphen in the middle, the a, e, -, f, and j should not move, but the b, c, d, g, h, and i should be jumbled.

Letter jumbling should be done via use of RND in some form. I'll be including RANDOMIZE TIMER in the test code. You just need to write the Jumble$ function.

Should be self-contatined--not making calls to other subs or functions, external files, extra libraries, etc.

I'm looking for clearly-written, efficient code. It should be understandable. Speed is not really an issue unless you manage to make something run ridiculously slow :p. Display should be to the screen, via print statement. Basically, I'm going to be doing this:

Code:

RANDOMIZE TIMER
InputText$ = "Something random that I put in here, abiding by my own rules of allowed characters."
PRINT Jumble$(InputText$)

So.. if you have any questions, let me know! There's no real official deadline, just whenever people stop submitting.

*peace*

Meg.

[HQSneaker]

Code:

'returns a String containing all the ASCII characters that are NOT in letters$
'(only needed for initialization)
DECLARE FUNCTION invertchars$ (letters$)

'Reads the next "word" from s$, starting at position position%.
'Updates the position% (so you must use CALL to use this function).
'(a "word" is the longest string that can be made with the set of
'letters in letters$)
DECLARE SUB nextword (s$, letters$, position%, word$)

'Randomly mix up the word keeping the first and last letters fixed.
DECLARE FUNCTION adjust$ (word$)

'Randomly mix up the letters in the word.
DECLARE FUNCTION mix$ (word$)

'Delete a sequence of length% characters starting at index%.
DECLARE FUNCTION delmid$ (word$, index%, length%)

' ******************** INITIALIZATION ********************

'String with all the letters that are used to make words
letters$ = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
'The spacing between two arguments in command$ (space or tab)
spacing$ = " " + CHR$(9)

'nonletters$: String with all the letters that are NOT used to make words
'Note that this must contain all characters that are not in letters$,
'otherwise we can get an infinite loop when a character is encountered
'that is not in either one of the strings.
nonletters$ = invertchars$(letters$)
nonspacing$ = invertchars$(spacing$)

'Useful to get different mixes each time we run the program...
RANDOMIZE TIMER

'Read in the command line options from the string command$
position% = 1
CALL nextword(COMMAND$, nonspacing$, position%, infile$)
CALL nextword(COMMAND$, spacing$, position%, outfile$)
CALL nextword(COMMAND$, nonspacing$, position%, outfile$)

IF infile$ = "" OR outfile$ = "" THEN
    PRINT
    PRINT "Usage: mixer <inputfile> <outputfile>"
    PRINT
    PRINT "Mixer takes a text file as input and outputs a file where the letters of "
    PRINT "each word are randomly mixed up, keeping the first and the last letter fixed."
    PRINT "You will see that as long as the words aren't too long you can still read "
    PRINT "the text very well."
    END
END IF

' ******************** MAIN PROGRAM ********************

in% = FREEFILE
OPEN infile$ FOR INPUT AS in%
  'Read the whole file at once
  text$ = INPUT$(LOF(in%), in%)
CLOSE in%

outp% = FREEFILE
OPEN outfile$ FOR OUTPUT AS outp%

position% = 1
WHILE position% <= LEN(text$)
    'Read the next "non"word: a sequence of characters that aren't letters.
    CALL nextword(text$, nonletters$, position%, word$)
    PRINT #outp%, word$;

    'PRINT word$;

    'Read the next word and mix up the letters (except the first and the last).
    CALL nextword(text$, letters$, position%, word$)
    word$ = adjust$(word$)
    PRINT #outp%, word$;
    'PRINT word$;
WEND

CLOSE outp%

'Randomly mix up the word keeping the first and last letters fixed.
'
FUNCTION adjust$ (word$)
  IF LEN(word$) <= 2 THEN
      adjust$ = word$
  ELSE
      'Take first and last letter fixed and mix the other letters
      adjust$ = MID$(word$, 1, 1) + mix$(MID$(word$, 2, LEN(word$) - 2)) + MID$(word$, LEN(word$), 1)
  END IF
END FUNCTION

'Delete a sequence of length% characters starting at index%.
'
FUNCTION delmid$ (word$, index%, length%)
    delmid$ = MID$(word$, 1, index% - 1) + MID$(word$, index% + length%, LEN(word$) - index% - length% + 1)
END FUNCTION

'returns a String containing all the ASCII characters that are NOT in letters$
FUNCTION invertchars$ (chars$)

    FOR i% = 0 TO 255
        ch$ = CHR$(i%)
        IF INSTR(chars$, ch$) = 0 THEN nonchars$ = nonchars$ + ch$
    NEXT i%
    invertchars$ = nonchars$

END FUNCTION

'Randomly mix up the letters in the word.
'
FUNCTION mix$ (word$)
    WHILE LEN(word$) > 0
        index% = INT(RND * LEN(word$)) + 1
        result$ = result$ + MID$(word$, index%, 1)
        word$ = delmid$(word$, index%, 1)
    WEND
    mix$ = result$
END FUNCTION

'Reads the next "word" from the string s$, starting at position position%.
'Updates the position% (so you must use CALL to use this function).
'(a "word" is the longest string that can be made with the set of
'letters in letters$)
'
SUB nextword (s$, letters$, position%, word$)
    word$ = ""
    DO WHILE position% <= LEN(s$)
        ch$ = MID$(s$, position%, 1)
        IF INSTR(letters$, ch$) = 0 THEN EXIT DO
        'Character was OK, now add it and go to the next position.
        position% = position% + 1
        word$ = word$ + ch$
    LOOP
END SUB

[Meg]

Heheh this submission was posted while I was still in the process of writin g the challenge, and obviously doesn't meet some of the challenge criteria. Very impressive, though! >o.O;<

[Antoni Gual]

This is my entry,I tried to make it simple.
It can be improved: the shuffling is too random, sometimes leaves words in the correct order..

Code:

'Word Jumbler
'Antoni Gual for Meg's contest 21/sept/04
'
'DEMO
'
DECLARE FUNCTION jumble$ (Work$)
RANDOMIZE TIMER
InputText$="All that is gold does not glitter, Not all those who wander are lost;The old that is strong does not wither, Deep roots are not reached by the frost."
PRINT jumble$(InputText$)
END
'
'
'
FUNCTION jumble$ (InputText$)
'
'An input with less than 4 letters does'nt need to be jumbled
'
IF LEN(InputText$) < 4 THEN jumble$ = InputText$: EXIT FUNCTION
'
'list of chars not to jumble
separator$ = "0123456789,.?!$&();:-' " + CHR$(34)
'
'add the sentinel to the end of phrase
Work$ = InputText$ + "0"
'varaibles for start and end of word
ini% = 1
ends% = 1
'
'scan the phrase
FOR i% = 1 TO LEN(Work$)
  ch$ = MID$(Work$, i%, 1)
  ' check for separators  
  IF INSTR(separator$, ch$) = 0 THEN
    'if separator, advance end
    ends% = ends% + 1
  ELSE
    'jumble it,if word has  more than 3 letters
    IF ends% - ini% > 3 THEN
      ' To simplify indexes we get in temp$ the part of the word to be jumbled
      temp$ = MID$(Work$, ini% + 1, ends% - ini% - 2)
      'simply shuffle the string putting end before start several times
      l% = LEN(temp$)
      FOR j% = 1 TO SQR(l%)
        r% = INT(RND * (l% - 1)) + 1
        LSET temp$ = MID$(temp$, r% + 1) + LEFT$(temp$, r%)
      NEXT
      'copy back the shuffled part into the phrase
      MID$(Work$, ini% + 1) = temp$
    END IF
    'reset ini% and end% for a new word
    ini% = i% + 1
    ends% = i% + 1
  END IF
NEXT
'remove sentinel from the output phrase
jumble$ = LEFT$(Work$, LEN(Work$) - 1)
END FUNCTION

[Meg]

It seems that this program does fit the challenge criteria. Well done! It was sort of funny, though. I tried the word "blacklist" and it kicked out "blacklist" as output. I tried it five times, and on the fifth attempt it scrambled it.

I'll take the time to go through the code line by line to see how it works, soon. Let's see some more entries! Antoni has set the bar. Maybe somebody can find a simpler, more straightforward way of doing this challenge.

*peace*

Meg.

[Antoni Gual]

I tried the word "blacklist" and it kicked out "blacklist" as output. I tried it five times, and on the fifth attempt it scrambled it.

Just a case of bad luck
The scrambler is too simple!

[ToohTooh]

I don't like to post code to boards, but this challenge I liked!..

Here's the solution I came up with:

Code:

'
'-- Eye crosser(?)
'

'-- Takes any linguistic piece and sends it back messed up.
'   Use that StrTok$ right away and think about its past.
'   Pretty elegant code here.

'-- ToohTooh, in Istanbul.

DEFINT A-Z

DECLARE FUNCTION Scramble$ (Word$)
DECLARE FUNCTION StrTok$ (Source$, Delimiters$)

CLS : LINE INPUT "Enter string to scramble:- ", p$

SELECT CASE p$
CASE ""  '-- Fall into the hopeless abyss and hope to be tugged back.
    END
CASE ELSE  '-- Do something nicer.
    seed! = TIMER  '-- ! will just do it
    RANDOMIZE seed!
    '-- Set up the characters that separate tokens (words). Add any language-
    '     specific delimiters, and scrambler won't get confused.
    Delimiters$ = " ,;:().?-" + CHR$(9) + CHR$(34)

    '-- Invoke StrTok$ with the string to tokenize.
    token$ = StrTok$(p$, Delimiters$)

    WHILE token$ <> ""
  
        PRINT Scramble$(token$);
        '-- Call StrTok$ with a null string so it knows this
        '     isn't the first call.
        token$ = StrTok$("", Delimiters$)

    WEND
END SELECT

FUNCTION Scramble$ (Word$)

max = LEN(Word$) - 1  '-- How many times shall we "do it"?

FOR i = 2 TO max
    a$ = MID$(Word$, i, 1)                '-- Pick the source.
    where = INT((max - 2 + 1) * RND + 2)  '-- Pick a random pos within Word$.
                 '-- ^^^^^^^ QB IDE won't optimize here.
    b$ = MID$(Word$, where, 1)            '-- Then, pick the destination.
    MID$(Word$, i, 1) = b$                '-- Insert b where a previously was.
    MID$(Word$, where, 1) = a$            '-- Insert a where b previously was.
NEXT i

Scramble$ = Word$  '-- Send it away.

END FUNCTION

FUNCTION StrTok$ (Srce$, Delim$)

STATIC STstart, STsaveStr$
            
'-- If first call, make a copy of the string.
IF Srce$ <> "" THEN
    STstart = 1: STsaveStr$ = Srce$
END IF

begPos = STstart: ln = LEN(STsaveStr$)

'-- Look for start of a token (character that isn't delimiter).
WHILE begPos <= ln AND INSTR(Delim$, MID$(STsaveStr$, begPos, 1)) <> 0
    begPos = begPos + 1
WEND

' Test for token start found.
IF begPos > ln THEN
    StrTok$ = ""
    EXIT FUNCTION
END IF

'-- Find the end of the token.
endPos = begPos
WHILE endPos <= ln AND INSTR(Delim$, MID$(STsaveStr$, endPos, 1)) = 0
    endPos = endPos + 1
WEND

'-- Send the token.
StrTok$ = MID$(STsaveStr$, begPos, endPos - begPos) + MID$(Delim$, INSTR(Delim$, MID$(STsaveStr$, endPos, 1)), 1)
                       '-- Here posts the delimiter ^^^

'-- Set starting point for search for next token.
STstart = endPos

END FUNCTION

Have fun!..

[Meg]

i'm looking for just one function, without calls to outside subs/functions

you don't need to include RANDOMIZE, this will be done by the calling prog

looking for simple, clear, efficient code

Any other entries?

*peace*

Meg

[ToohTooh]

Hello, Meg.

Hmm, you won't get both efficiency and one-function-code.

One should set goals, not the programming styles (except for very rare cases).

If we are to limit ourselves to "number of functions," then we will end up with spaghetti code. If we are to squeeze actions into functions, the golden "granularity rule" is broken...

The more it breaks down into functions, the better.

Looking for another entries here, too.

[Antoni Gual]

This version ensures every character is moved from his place...

Code:

'Word scrambler
'Antoni Gual for Meg's contest 21/sept/04
'
'DEMO
'
DECLARE FUNCTION jumble$ (Work$)
RANDOMIZE TIMER
InputText$="All that is gold does not glitter, Not all those who wander are lost;The old that is strong does not wither, Deep roots are not reached by the frost."
PRINT jumble$(InputText$)
END
'
'
FUNCTION jumble$ (InputText$)
'
'An input with less than 4 letters does'nt need to be jumbled
'
IF LEN(InputText$) < 4 THEN jumble$ = InputText$: EXIT FUNCTION
'
'list of chars not to jumble
separator$ = "0123456789,.?!$&();:-' " + CHR$(34)
'
'add the sentinel to the end of phrase
Work$ = InputText$ + "0"
'variables for start and end of word
ini% = 1
ends% = 1
'
'scan the phrase
FOR i% = 1 TO LEN(Work$)
  ch$ = MID$(Work$, i%, 1)
  ' check for separators    
  IF INSTR(separator$, ch$) = 0 THEN
    'if separator, advance end
    ends% = ends% + 1
  ELSE
    'jumble it,if word has  more than 3 letters
    IF ends% - ini% > 3 THEN
      ' To simplify indexes we get in temp$ the part of the word to be jumbled
      temp$ = MID$(Work$, ini% + 1, ends% - ini% - 2)
      l% = LEN(temp$)
          
       'Scramble: scan the entire string, left to right
       FOR j% = 1 TO l% - 1
        'put in the i% position a char of the range i%+1 to j%
        r% = int(RND * (l% - j%)) + j%+1
        MID$(temp$, j%) = MID$(temp$, r%, 1) + MID$(temp$, j%, r% - j%) + MID$(temp$, r% + 1)
       NEXT
      'copy back the shuffled part into the phrase
      MID$(Work$, ini% + 1) = temp$
    END IF
    'reset ini% and end% for a new word
    ini% = i% + 1
    ends% = i% + 1
  END IF
NEXT
'remove sentinel from the output phrase
jumble$ = LEFT$(Work$, LEN(Work$) - 1)
END FUNCTION