Word Progression Puzzle

[Gösta H. Lovgren-2]

Just for fun I am trying to figure out the logic to solve a Word Progression puzzle, but am stumped. I have a file that has over 100,000 words and each Ascii value (I built to solve Jumble puzzles). Originally I thought I could just use an Ascii progression somehow but no good so far.

Here's a sample:

Turn the word 'THINK' into 'BRAIN' by changing one letter at a time.
Each new word must be a real word.
Answer: 'note Number is the ascii value of the word from the file
THINK '382
THICK '371
TRICK '381
TRACK '373
TRACT '382
TRAIT '388
TRAIN '382
BRAIN '364

There are 6,919 actual 5 letter words between
BACCA 330 (lowest Ascii) and MUZZY 431 (highest Ascii)

Anyone have any thoughts on the logic.

============================================================
"The only way to get rid of a temptation
is to yield to it."
Oscar Wilde (1854-1900)
============================================================

[Rodney Hicks]

Could you provide a little more detail? So far to me the logic is illogical. You have three words with the same 'ascii' value. How does the 'ascii' value help you? How do yo arrive at you 'ascii' value?

What word has the lowest 'ascii' value. What word has the highest. In other words, what is the 'ascii' value range? Does this apply to only five letter words.

[Gösta H. Lovgren-2]

Could you provide a little more detail? So far to me the logic is illogical. You have three words with the same 'ascii' value. How does the 'ascii' value help you? How do yo arrive at you 'ascii' value?

Okay I should have been more clear. What I should have said is "Ascii Total" for each word instead of just "Ascii". Total = the total of all letters in the word. Probably instead of Ascii, the accurate term would have been "Hash".

The file of 100,000+ words I mentioned is a file of unique words though not all have unique ascii totals (the file is sorted by ascii totals). In this case, I thought it might be of use in solving the puzzle. For solving Word Jumbles, using the file, 10 jumbled letter words are returned in fraction of a second.

What word has the lowest 'ascii' value.

THICK '371

What word has the highest.

TRAIT '388

In other words, what is the 'ascii' value range?

While I don't know, I'm guessing interim steps (though obviously not in this set) could range much farther.

Does this apply to only five letter words.

The puzzle in this case is 5 letter words. I've seen puzzles using other lengths. I'm just stumped in how to proceed. Just an interesting exercise in logic is all.

[Elias Montoya]

could you post the file with the words? that sounds like a good challenge.

[Gösta H. Lovgren-2]

could you post the file with the words? that sounds like a good challenge.

It is a challenge. {grin}

I posted the file so all PB'ers can have it:

http://www.SwedesDock.com/powerbasic/Words.zip

There are 110,000 words in the file in Ascii Total order.

Not that it relates here but I built the file originally to check/suggest spelling in Z-Post (built on the EZ-Post principle). Sometimes I get hung up on a spelling I know is wrong but the correct way just escapes me. I Clipboard the word, launch Z-Post and it presents a list of possible spellings to choose from. Exceedingly fast. (fraction of a second again)

=======================================================
"Once you eliminate the impossible,
whatever remains,
no matter how improbable,
must be the truth."
Sherlock Holmes (by Sir Arthur Conan Doyle, 1859-1930)
=======================================================

[Rodney Hicks]

Having slept on the dellightful problem YOU have, I have decided that at the present I cannot spend much time on it. However, I may in the future if someone hasn't solved the problem.

A couple of points though.

Providing that the first word, call it 12345 has all different letters than the second in each position such as this second word, 67890.
You have a minimum of five moves.
These moves are the same from 12345 to 67890 as they are from 67890 to 12345, just reversed.
By working both ends against the middle you might arrive at the solution sooner.
You might be able to delete extra (im)possibilities by comparing each of the 'list of possibles' at each step.
And I know nothing about the kind of hash you're talking about.
I look forward to hearing of your success.

Rod

[Gösta H. Lovgren-2]

The frist step

Word Progesssion Solving
For example: 'THINK' into 'BRAIN'
by changing one letter at a time
' Answer Sequence:
'THINK 't1$
'THICK
'TRICK
'TRACK
'TRACT
'TRAIT
'TRAIN
'BRAIN 't2$
'
Okay finding the first set of words in the progression is easy:

'Wrds$ holds all 5 letter words
 t3$ = t1$ & " = " 'holder
 s$ = t1$
Find_Word: 
 For x = 1 To ln 'letter length - 5 in example
    For y = 65 To 90 'A - Z
      LSet s$ = t1$ 'first word
      Mid$(s$, x) = Chr$(y)'try a letter
      If InStr(Wrds$, s$) And _ 
         s$ <> t1$ Then 'see if it fits
         t3$ = t3$ & " " & s$ 'it does so display it
      End If
    Next y       
 Next x

t3$ contains:
THINK = CHINK THANK THICK THINE THING THINS

We know THICK is the second step (because we already know the answer) in the progression but how does the algorithym know it? What's the next step?

[Paul Dixon]

Gösta,
your algorithm doesn't know it. You need to search for the best solution.

Given your start word (THINK) and aiming for your destination word (BRAIN):
1) use your start word to generate all possible subsequent words exactly as you have done
2) use each of the words generated in the previous step as a new start word to generate the next sets of words.
3) repeat step 2 until one (or more) of the sequences generates your destinaton word.

It looks lke a recursive solution might be good.

Paul.

[Rodney Hicks]

Your next step is to find 'BRAIN' and all the real words that exist with one letter difference.
Compare the two lists.
Mayhaps there is a word there with only three letters that need to be changed?(I'm not sure how your program will recognize it. And this is why I don't have time to figure it all out.)
If not, then look at those that need four letters changed, then five.
If we assume an average of six words from each word you will end up with the following

Beginning                                            1 word
first step                                  6 words
second step                                       36 words
third step                                        216 words
fourth step                                       1296 words
fifth step  a)                                    7776 words
                b)                                   check for your word
sixth step a)                                      46,656 words
               b)                                    check for your word
.
.
.
second last step                                         found your word.
last step                                              trace its parentage to your first word.

OR

beginning                        1 word(first)      AND       1 word(target)
first step                       6 words             "        6 words
second step                                  check for convergence
third step                      36 words            AND       36 words
fourth step                                   check for convergence
fifth step                       216 words          AND       216 words
sixth step                                  check for convergence or a match
seventh step                    1296 words           AND      1296 words
eighth step                              check for convergence or a match
.....
Nth step                                        found a match
Nth+1 step                        follow each parent to its parent to its parent....

The matched word and its parents are three of the words in the chain.
The matched word and its parents and their parents and their parents.....to the first and target words are your chain.
Rod

[Gösta H. Lovgren-2]

Paul & Rod,

Clearly recursion is the answer. Just how to program it is the challenge (for me anyway). {sad rueful wistful smile}. I'll just keep pluggin' away at it.

Seems pretty clear though, at this point, the Ascii_Totals (hashes?) are not going to be part of the answer as I thought would be at the beginning.

=====================================
" The best way to predict the future
is to invent it."
Alan Kay
=====================================

[John Gleason]

This rapidly finds 1-letter differences. It finds all 1-letter differences of all 6-letter words in just seconds. I'll work on it more in a while, but the idea is:
1) Start word>>1-letter difference list (in an array--arr1())
2) End word>>1-letter difference list (in another array--arr2())
3) compare 2 arrays for any matches
*yes match? you're done!
*no match?
4)make 1-letter difference list FOR EACH Start word 1-letter difference element.
5)make 1-letter difference list FOR EACH End word 1-letter difference element.
6) compare 2 arrays for any matches
*yes match? you're done!
*no match?
7)make 1-letter difference list FOR EACH Start word 2-letter difference element.
8)make 1-letter difference list FOR EACH End word 2-letter difference element.
You can put step 7 all into one array(arr5())
You can put step 8 all into one array(arr6())
... until match or 6 (or 5, 4, however many you want) letters reached.

#COMPILE EXE
#DIM ALL

UNION sixMax
   cLine AS STRING * 4
   cLong AS LONG
END UNION

FUNCTION PBMAIN () AS LONG
  LOCAL lineo AS STRING, ii, ii2, ii3, index, endLoop AS LONG
  LOCAL compressLineo AS sixMax
  DIM word6(11492) AS LONG, wordOrig6(11492) AS STRING * 6, acacia(6) AS LONG, blank(6) AS LONG
    OPEN "C:\WINDOWS\Desktop\Words.txt" FOR INPUT LOCK SHARED AS #1
    '-----------------------------------------------------------
    'put words in a fast to use LONG format and store in word6() array. 6 is max letters for this technique, and used here.
    'if 7 or more needed (12 max), the UNION would need to go to QUAD/8 and therefore be slower.
    '-----------------------------------------------------------
    FOR ii = 1 TO 54000
       LINE INPUT #1, lineo
       IF LEN(lineo) = 12 THEN                                'is it 6 letters long?
          compressLineo.cLong = 0
          ASC(compressLineo.cLine, 1) = ASC(lineo, 12) - &h40  'stuff each capital letter--1 to 26--into 5 bit space. (32 max for 5 bits)
          ROTATE RIGHT compressLineo.cLong, 5
          ASC(compressLineo.cLine, 1) = ASC(lineo, 11) - &h40  'stuff each capital letter--1 to 26--into 5 bit space. (32 max for 5 bits)
          ROTATE RIGHT compressLineo.cLong, 5
          ASC(compressLineo.cLine, 1) = ASC(lineo, 10) - &h40  'stuff each capital letter--1 to 26--into 5 bit space. (32 max for 5 bits)
          ROTATE RIGHT compressLineo.cLong, 5
          ASC(compressLineo.cLine, 1) = ASC(lineo,  9) - &h40  'stuff each capital letter--1 to 26--into 5 bit space. (32 max for 5 bits)
          ROTATE RIGHT compressLineo.cLong, 5
          ASC(compressLineo.cLine, 1) = ASC(lineo,  8) - &h40  'stuff each capital letter--1 to 26--into 5 bit space. (32 max for 5 bits)
          ROTATE RIGHT compressLineo.cLong, 5
          ASC(compressLineo.cLine, 1) = ASC(lineo,  7) - &h40 + ASC(compressLineo.cLine, 1)  'last letter
          ROTATE RIGHT compressLineo.cLong, 7
          word6(index) = compressLineo.cLong
          wordOrig6(index) = RIGHT$(lineo, 6)
          INCR index
       END IF
    NEXT
    '-----------------------------------------------------------
    'Array is now filled with all 6 letter words.
    'Next, see if "ACACIA" has any other words that are 1 letter different...
    '-----------------------------------------------------------
    blank(1) = &b11111111111111111111111111100000  'first make a mask to test each of 6 1-letter differences
    blank(2) = &b11111111111111111111110000011111
    blank(3) = &b11111111111111111000001111111111
    blank(4) = &b11111111111100000111111111111111
    blank(5) = &b11111110000011111111111111111111
    blank(6) = &b11000001111111111111111111111111
    
    FOR ii3 = 0 TO 11492                           'starting with ACACIA, test words for any 1-letter-different matches
       FOR ii2 = 1 TO 6
          acacia(ii2) = word6(ii3) AND blank(ii2)
          FOR ii = 0 TO 11492
             IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                IF ii <> ii3 THEN                     'eliminate match with itself
                   ? "Found a 1-letter difference! " & $CRLF & wordOrig6(ii3) & $CRLF & "pos " & STR$(7 - ii2) & $CRLF & wordOrig6(ii)
                   INCR endLoop
                   IF endLoop = 10 GOTO exitFor
                END IF
             END IF
          NEXT
       NEXT
    NEXT
  exitFor:
    ? "done"
END FUNCTION

[Gösta H. Lovgren-2]

After first step

Word Progesssion Solving

For example: 'THINK' into 'BRAIN'
by changing one letter at a time.

The Actual Answer Sequence is:
THINK
--THICK
----TRICK
------TRACK
--------TRACT
----------TRAIT
------------TRAIN
--------------BRAIN

***********************

After 910 Repetitions
THINK = CHINK THANK THICK THINE THING THINS

CHINK = CLINK CHUNK CHICK CHIRK CHINA CHINE CHINO CHINS
THANK = SHANK THANE
THICK = TRICK
THINE = RHINE SHINE WHINE TRINE TWINE
THING = OHING TYING THONG
THINS = SHINS TWINS THENS


Here's the code snippet to arrive at above:

   'Wrds$ holds all 5 letter words
   't1$ = Starting Word
   't2$ = Ending word 
   Wrds$ = Remove$(Wrds$, t1$) 'want no duplicate matches
   Wrds$ = Remove$(Wrds$, t2$)
 
 
 t3$ = t1$ & " = " 'holder
 t$ = t1$        
 Reset ctr, flag  
 ctr5 = 100
 
 Erase tmp$
 GoSub Find_Word 'first step
      'tmp$() returns with all possibles for the first word
 
 
  For ctr = LBound(tmp$) To UBound(tmp$)  
    t$ = tmp$(ctr) 't$ used in 
    Reset t4$ 'will hold possibilities for t$ 
    GoSub Find_Word1 'next steps
    tmp$(ctr) = tmp$(ctr) & " = " & t4$ 'for display
  Next ctr
 
   'for display
  t$ = t5$ & $CrLf & $CrLf & _
       Using$(" After #, Repetitions", Reps) & $CrLf & _
       t3$ & $CrLf & $CrLf 
 
  For ctr = LBound(tmp$) To UBound(tmp$)  
    t$ = t$ & Space$(ln) & tmp$(ctr) & $CrLf 
  Next ctr
 
  't$ = t$ & $CrLf & $CrLf  & $CrLf &  _
   '    Ans_Sequence$
 Set_Text
 Set_Clipboard
Exit Sub 
'
Find_Word1:                
  s$ = tmp$(ctr)
   For x = 1 To ln 'letter length - 5 in example
      For y = 65 To 90 'A - Z
        incr reps
        LSet s$ = t$ 'word to find
        Mid$(s$, x) = Chr$(y)'try a letter
        If InStr(Wrds$, s$) Then 'see if it fits
          t4$ = t4$ & s$ & " "  'it does so display it
          Wrds$ = Remove$(Wrds$, s$)'don't use it again
        End If
      Next y       
   Next x      
 Return 
'
 
Find_Word:
 s$ = t$
   For x = 1 To ln 'letter length - 5 in example
      For y = 65 To 90 'A - Z
        incr reps
        LSet s$ = t$ 'word to find
        Mid$(s$, x) = Chr$(y)'try a letter
        If InStr(Wrds$, s$) Then 'see if it fits
           t3$ = t3$ & " " & s$ 'it does so display it
          ReDim Preserve tmp$(UBound(tmp$) + 1)
          tmp$(UBound(tmp$)) = s$
          Wrds$ = Remove$(Wrds$, s$)'don't use it again
        End If
      Next y       
   Next x      
 Return 
'

Am stumped on how to continue recursion. It's clear (because we know the answer) the progression (so far) is THINK to THICK to TRICK to ... but how does the program know that?

It seems to me there should be a While/Wend in here somewhere but I'm unsure where.


============================================================
Why not be oneself?
That is the whole secret of a successful appearance.
If one is a greyhound,
why try to look like a Pekingese?
Edith Sitwell
============================================================

[Gösta H. Lovgren-2]

John, we posted together {grin}. I ran your code, but unfortunately I don't understand it (yet). A lot is over my head (for example Unions). Here are the questions arriving (so far):

1) How did you arrive at the magic number of 11492? (as in word6(11492))

2) Why only read 54,000 lines in Words.txt? If it's the same file I use, there are 109,581 lines in it. Did you determine there were no 6 letter words after line 54,000? Just curious.


Could you use a real world progression (such as THINK to BRAIN as in this case) as inputs. At least then I would have a better chance of following the logic, maybe not much but some anyway.

And not to be a wiseguy, I don't see how this helps solving the problem. Nor do I see it any real world faster than the method I am pursuing. It is faster but each is under a second (your's virtually instantaneous vs .4 second for mine) and neither has found a solution yet.

What I'll do today is try to put my Sub into compilable form and post it (as you did yours). Thanks the effort. It's turning out to be quite interesting. {grin}

============================================================
"There are only two ways to live your life.
One is as though nothing is a miracle.
The other is as though everything is a miracle."
Albert Einstein (1879-1955)
============================================================

[Rodney Hicks]

You might make checking for letters from the target word in the correct position in the word your checking an important part of your search. Not all words found thusly will be the best word, but in most cases they likely will be.
The only way the program will know that it has met up with the correct word is if a match comparison is attained, and positional matches are not only essential steps, they are the purpose.

For example your third test line resulted in a match for the second letter of the target word. When you have a match KEEP the word and move on to the next. The word THICK led you to TRICK, which has the letter R in the same position as your target word. There fore, keep the THINK-THICK-TRICK and follow the words that have the R in that position instead of checking the rest of the THINK generated words. Write your program so you can return to that point in case you run into a dead end. The following steps you didn't need to do yet.

THINE = RHINE SHINE WHINE TRINE TWINE
THING = OHING TYING THONG
THINS = SHINS TWINS THENS

And, incidentally, in this case, if you were to have been alternating from the top to bottom, you would have matched the T in the first step and you would have two of the five letters you seek already if you checked your matches. Having the Parent word searching for its child and the Child word searching for its parent will make the search faster. The words that the successive words are derived from are Parent/Child.

Your program will be a lot faster by working both ends against the middle because with each letter matched, the fewer possibilities you have to consider.

Gösta
I see you posted while I was composing this. I don't understand why he's using 6 letter words, but he's working towards the middle from both ends and that is the way to go.(At least he's not working of four letter words.)

Rod

[Gösta H. Lovgren-2]

Here's my code in compileable form: You will have to change the location of "Words.txt" to conform to your setup if it's not in the same folder as the code.

'

#Compile Exe
#Dim All
'------------------------------------------------------------------------------
'   ** Includes **
'------------------------------------------------------------------------------
    #Include "WIN32API.INC"
'    #Include "C:\Power Basic\Includes\clipboard.inc"
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** Constants **
'------------------------------------------------------------------------------
%Box_Height = 20
%Char_Width = 5
 
%TB_Data_Set_Folder_and_Name = 1001
%Btn_01  = 1002
%Btn_Two_Id  = 1003
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** Declarations **
'------------------------------------------------------------------------------
Declare CallBack Function Dialog_CB_Processor()
Declare Function Main_Dialog(ByVal hParent As Dword) As Long
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** Macros **
'------------------------------------------------------------------------------
Macro Common_Locals
   ' Put ALL local variables here in Alpha order for easy reference
'#Include "C:\Power Basic\Includes\Variables_Common_to_All_Programs.inc"
 
      'for Word Progression to run
 Local Row&, Col&, Wdth&, Hght&, lRslt&
 Local Ans_Sequence$
 Local Wrds$, wrds1$, Reps&, x&, y& 
 Local g_Timer# 
 Local m$, m1$
 Local t$, t1$, t2$, t3$, t4$, t5$
 Local tmp$(), tmp1$()
  Global g_Words$()
End Macro
'------------------------------------------------------------------------------
 
'------------------------------------------------------------------------------
'   ** Globals **
'------------------------------------------------------------------------------
    Global hDlg  As Dword
'------------------------------------------------------------------------------
 
'------------------------------------------------------------------------------
'   ** Main Application Entry Point **
'------------------------------------------------------------------------------
Function PBMain()
    Main_Dialog %HWND_DESKTOP
End Function
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** CallBacks **
'------------------------------------------------------------------------------
CallBack Function Dialog_CB_Processor()
    Local lRet  As Long
    Select Case As Long CbMsg
        Case %WM_INITDIALOG
        Case %WM_COMMAND
            ' Process control notifications
            Select Case As Long CbCtl
                Case %TB_Data_Set_Folder_and_Name        
                Case %Btn_01
                  Call Word_Progression_Puzzle
 
            End Select
    End Select
End Function
'------------------------------------------------------------------------------
'
Macro m_Fill_G_Words_Array
 'g_Words$(ctr) = "ASCII_Value Word"
 ' ie " 2099 ANTIDISESTABLISHMENTARIANISM" 
 ' or "  131 AB"
     fnum = FreeFile
     fn$ = CurDir$ & "\Words.txt" '<-- file created beforehand 
     Open fn$ For Binary As #fnum
 
     ctr = Lof(#fnum)  
     If ctr = 0 Then
 '      m_beep
'       m$ = fn$:m1$ = "File not found": mb 
'       Close
'       Exit Sub
     End If
     Local temp$ 
     temp$ = Space$(ctr) 'make big string
     Get #fnum, 1, temp$
     Close      
     ctr = ParseCount(temp$, $CrLf)
     ReDim  g_Words$(ctr)
     Parse temp$,  g_Words$(), $CrLf          
End Macro
'
'****************************************************************************
Sub Word_Progression_Puzzle
'Turn the word 'THINK' into 'BRAIN'" by changing one letter at a time" 
' each new word must be a real word. 
'  Answer:  'note Number is the ascii value of the word 
   'THINK  382 
   'THICK  371 
   'TRICK  381 
   'TRACK  373 
   'TRACT  382 
   'TRAIT  388 
   'TRAIN  382 
   'BRAIN  364  
'There are 6,919 actual 5 letter words between 
'BACCA 330 and MUZZY 431
  Common_Locals
 Ans_Sequence$ = _
   "The Actual Answer Sequence is:" & $CrLf & _
   " THINK" & $CrLf & _
   "   THICK" & $CrLf & _
   "   TRICK" & $CrLf & _
   "   TRACK" & $CrLf & _ 
   "   TRACT" & $CrLf & _ 
   "   TRAIT" & $CrLf & _ 
   "   TRAIN" & $CrLf & _
   " BRAIN" & $CrLf & $CrLf 
 
 
  g_Timer = Timer
  m$ = "   Word Progesssion Solving " & $CrLf & $CrLf & _
       "For example: 'THINK' into 'BRAIN'" & $CrLf & _                            
       "by changing one letter at a time." & $CrLf & $CrLf & _
       Ans_Sequence$
  'm_Save_Screen 'macro not needed here           
  'get_text   'macro not needed here           
  t$ = "Think Brain" 'testing only
  t5$ = m$  'for restoring screen when done
 
  'make sure it's only two words
  t$ = UCase$(Trim$(t$))
  Local i&
  i = InStr(t$, " ")
   'split into two words
   If i Then            
      t1$ = Left$(t$, i - 1)
      t2$ = Mid$(t$, i + 1)
      Local Flag&
      Flag = InStr(t2$, " ")'if space then more than one word left
      If flag Then
        m1$ = "Not more than 2 words allowed"
      End If
     Else 
      Incr flag                    
      m1$ = "Must be 2 words"
   End If 
  If Len(t2$) <> Len(t1$) Then 
    Incr flag   
    m1$ = "Must consist of two equal length words"
  End If  
    'not proper words
  If flag Then       
     'mb_Alert 'macro not needed here           
     'm_Restore_Screen  'macro not needed here           
     Exit Sub
  End If   
  'G_Words$ holds Words.txt
 If UBound(g_Words$()) < 1 Then 'not created yet
    Local fnum&, fn$, ctr&
 
    m_fill_G_Words_Array 'Array = "ASCII_Value Word"
                         ' ie " 2099 ANTIDISESTABLISHMENTARIANISM" 
                         ' or "  131 AB"
 
 End If                 
 Local ln&
 ln = Len(t1$)
 Local ctr1&
 Reset ctr1  
 
 'count ln letter words and put in Wrds$
 For ctr = LBound(g_Words) To UBound(g_words)
    If Len(Mid$(g_words(ctr), 7)) = ln Then
       ReDim Preserve tmp$(UBound(tmp$) + 1) 'temporary array holder
          tmp$(UBound(tmp$)) = Mid$(g_words(ctr), 7)'Word starts at psn 7
       Incr ctr1
       If Len(t3$) < 5 Then t3$ = g_words(ctr)'lowest ascii possible
       t4$ = g_words(ctr) 'highest ascii 
    End If 
 Next ctr  
 'place Words$ in alpha order JIC needed later
   Array Sort tmp$()
    Reset Wrds$ 'put in single string
    For x = LBound(tmp$) To UBound(tmp$)
      Wrds$ = Wrds$ & tmp$(x) & " "
    Next x                         
  m1$ = t3$ & $CrLf & t4$ & $CrLf & _
        Using$("#, # letter words possible ", ctr1, ln)
'  mb 'MessageBox macro uses m$ & m1$
' z_ln_Length_Words_in_WordLst_File 'different word list
' Answer Sequence:        
   'THINK  't1$
   'THICK 
   'TRICK 
   'TRACK 
   'TRACT 
   'TRAIT 
   'TRAIN 
   'BRAIN  't2$
'          
   'Wrds$ holds all 5 letter words
   't1$ = Starting Word
   't2$ = Ending word 
   Wrds$ = Remove$(Wrds$, t1$) 'want no duplicate matches
   Wrds$ = Remove$(Wrds$, t2$)
 
 
 t3$ = t1$ & " = " 'holder
 t$ = t1$             
 Local ctr5&
 Reset ctr, flag
 ctr5 = 100
 
 Erase tmp$
 GoSub Find_Word 'first step
      'tmp$() returns with all possibles for the first word
 
  For ctr = LBound(tmp$) To UBound(tmp$)  
    t$ = tmp$(ctr) 't$ used in 
    Reset t4$ 'will hold possibilities for t$ 
    GoSub Find_Word1 'next steps
    tmp$(ctr) = tmp$(ctr) & " = " & t4$ 'for display
  Next ctr
   'for display
  t$ = t5$ & $CrLf & $CrLf & _
       Using$(" After #, Repetitions", Reps) & $CrLf & _
       t3$ & $CrLf & $CrLf 
 
  For ctr = LBound(tmp$) To UBound(tmp$)  
    t$ = t$ & Space$(ln) & tmp$(ctr) & $CrLf 
  Next ctr
 
  't$ = t$ & $CrLf & $CrLf  & $CrLf &  _
   '    Ans_Sequence$
   t$ = Using$("  Took #.## Seconds to run ", Timer - g_Timer#) & _
       $CrLf & $CrLf & t$
   ? t$,, "Word Progression so far"
' Set_Text
' Set_Clipboard
Exit Sub 
'
Find_Word1:                
  Local s$
  s$ = tmp$(ctr)
   For x = 1 To ln 'letter length - 5 in example
      For y = 65 To 90 'A - Z
        Incr reps
        LSet s$ = t$ 'word to find
        Mid$(s$, x) = Chr$(y)'try a letter
        If InStr(Wrds$, s$) Then 'see if it fits
          t4$ = t4$ & s$ & " "  'it does so display it
          Wrds$ = Remove$(Wrds$, s$)'don't use it again
        End If
      Next y       
   Next x      
 Return 
'
Find_Word:
 s$ = t$
   For x = 1 To ln 'letter length - 5 in example
      For y = 65 To 90 'A - Z
        Incr reps
        LSet s$ = t$ 'word to find
        Mid$(s$, x) = Chr$(y)'try a letter
        If InStr(Wrds$, s$) Then 'see if it fits
           t3$ = t3$ & " " & s$ 'it does so display it
          ReDim Preserve tmp$(UBound(tmp$) + 1)
          tmp$(UBound(tmp$)) = s$
          Wrds$ = Remove$(Wrds$, s$)'don't use it again
        End If
      Next y       
   Next x      
 Return 
'
End Sub                      
'****************************************************************************
'------------------------------------------------------------------------------
'   ** Dialogs **
'------------------------------------------------------------------------------
Function Main_Dialog(ByVal hParent As Dword) As Long
   Common_Locals
     Row = 0
     Col = 0
     Wdth = 300
     Hght = 200
 
    Dialog New Pixels, hparent, "Word Progression", _
           , , Wdth, Hght, _
           To hDlg
'    Control Add TextBox, hDlg, %TB_Data_Set_Folder_and_Name, "D:\Temp\Sample_Data_Set.Txt", 5, 5, 200, 13
    Control Add Button,  hDlg, %Btn_01, "Word Progression", 25, 25, 200, 25
    Dialog Show Modal hDlg, Call Dialog_CB_Processor To lRslt
 
    Function = lRslt
End Function
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'

[Gösta H. Lovgren-2]

Rod,

While your logic is impeccable, converting it to code is another story (at least for me).

======================================================
"Everywhere I go I'm asked if I think
the university stifles writers.
My opinion is that they don't stifle enough of them."
Flannery O'Connor (1925-1964)
======================================================

[John Gleason]

1) How did you arrive at the magic number of 11492? (as in word6(11492))

11492 was the # of 6-letter words I found -1 for the 0 element.

2) Why only read 54,000 lines in Words.txt? If it's the same file I use, there are 109,581 lines in it. Did you determine there were no 6 letter words after line 54,000? Just curious.

Yes, I thought going like 30 grand past the last one I could find around 25,000 would be safe.

Could you use a real world progression (such as THINK to BRAIN as in this case) as inputs. At least then I would have a better chance of following the logic, maybe not much but some anyway.

Don't fret too much about the compression algorithm up at the top--it's just a way to get a six letter string into a 4-byte LONG, which we can really boogie with in our comparison algo. An analogy would be to think of the elements of word6() as, say, CVL("ACACIA"). It can't be done directly like that because ACACIA is 6 bytes and a LONG is 4 bytes, so I compressed it to fit.

The critical sequence algo remains the same: Take THINK; get all 1-letter changes (t1); take BRAIN; get all 1-letter changes (b1); compare t1 to b1. If no match (actually there can't be a match at this point because we didn't change enough letters yet with this example), take t1; get all 1-letter changes of EACH element (t2); take b1; get all 1-letter changes of EACH element (b2); compare t2 to b2. Continue until match is found.

Hope that's of help, but, I'll try in a while to show the THINK-BRAIN example. I believe it will always find the sequence in the least possible steps.

[Gösta H. Lovgren-2]

John,

I was looking at your code again. When I ran it with a timer earlier today I got a .00 time elapsed, so I thought is was so fast it was effectively instantaneous.

I just looked at it again to see if maybe I could use the compression stuff (no hope there for me I think) and noticed you had:

    Open "[B]C:\WINDOWS\Desktop[/B]\Words.txt" For Input Lock Shared As #1

Since that isn't where Words.Txt is on my machine it yielded an (untrapped) error. No file read, no arrays to check, it went pretty fast.

When I changed it to

    Open [B]CurDir$ & "[/B]\Words.txt" For Input Lock Shared As #1

the elapsed time went from .00 to .35 which makes it only .1 sec faster than my routine. Still apples to oranges though as we are working with different arrays.

[Gösta H. Lovgren-2]

Okay,

Sticking with the actual puzzle rather than theoreticals:

"THINK" = 6 possibilities (THINK = CHINK THANK THICK THINE THING THINS)

Now solving for "CHINK" (the first possibility) yields 8 possible steps (CHINK = CLINK CHUNK CHICK CHIRK CHINA CHINE CHINO CHINS) for the next step. None of those possibles can lead to the answer (because we already know the answer but the program doesn't). How does the program know that? The possibilities *seem* almost infinite.

Seems to me that solving that "CHINK" is a not a possible next step would be the key to going forward. to (THANK = SHANK THANE) to THICK to TRICK to ...

Turning out to be quite a quizzer, indeed.


============================================================
Faith is the proof of sights unseen
And the promise of things to come.
William Shakespeare
============================================================

[John Gleason]

This is proof of concept. There is HUGELY inefficient code and duplicate code in here, mainly to show how it works. I'm tagging along a ton of unnecessary string info for display, and the code is strung out rather than being placed in a function (and maybe even recursed). There is even, omg, string concatenation in here. But, with no logic--just brute force--it finds the sequence. And it'd be quite fast too with removal of the string stuff and a little optimization.

#COMPILE EXE
#DIM ALL

UNION sixMax
   cLine AS STRING * 4
   cLong AS LONG
END UNION

%NUMBERofWORDS = 6919

FUNCTION PBMAIN () AS LONG
  LOCAL lineo AS STRING, ii, ii2, ii3, ii4, index, index2, index3, index4, index5, index6, endLoop AS LONG
  LOCAL compressLineo AS sixMax
  DIM word6(%NUMBERofWORDS) AS LONG, wordOrig6(%NUMBERofWORDS) AS STRING, acacia(6) AS LONG, blank(6) AS LONG
  DIM a1(100) AS LONG, a2(1000) AS LONG, a3(1000) AS LONG
  DIM b1(100) AS LONG, b2(1000) AS LONG, b3(1000) AS LONG
  DIM as1(100) AS STRING, as2(1000) AS STRING, as3(1000) AS STRING
  DIM bs1(100) AS STRING, bs2(1000) AS STRING, bs3(1000) AS STRING
    OPEN "c:\Words.txt" FOR INPUT LOCK SHARED AS #1
    '-----------------------------------------------------------
    'put words in a fast to use LONG format and store in word6() array. 6 is max letters for this technique, and used here.
    'if 7 or more needed (12 max), the UNION would need to go to QUAD/8 and therefore be slower.
    '-----------------------------------------------------------
    FOR ii = 1 TO 54000
       LINE INPUT #1, lineo
       IF LEN(lineo) = 11 THEN                                'is it 6 letters long?
          compressLineo.cLong = 0
          ASC(compressLineo.cLine, 1) = ASC(lineo, 11) - &h40  'stuff each capital letter--1 to 26--into 5 bit space. (32 max for 5 bits)
          ROTATE RIGHT compressLineo.cLong, 5
          ASC(compressLineo.cLine, 1) = ASC(lineo, 10) - &h40  'stuff each capital letter--1 to 26--into 5 bit space. (32 max for 5 bits)
          ROTATE RIGHT compressLineo.cLong, 5
          ASC(compressLineo.cLine, 1) = ASC(lineo,  9) - &h40  'stuff each capital letter--1 to 26--into 5 bit space. (32 max for 5 bits)
          ROTATE RIGHT compressLineo.cLong, 5
          ASC(compressLineo.cLine, 1) = ASC(lineo,  8) - &h40  'stuff each capital letter--1 to 26--into 5 bit space. (32 max for 5 bits)
          ROTATE RIGHT compressLineo.cLong, 5
          ASC(compressLineo.cLine, 1) = ASC(lineo,  7) - &h40 + ASC(compressLineo.cLine, 1)  'last letter
          ROTATE RIGHT compressLineo.cLong, 12
          word6(index) = compressLineo.cLong
          wordOrig6(index) = RIGHT$(lineo, 5)
          INCR index
       END IF
    NEXT
    ? "Ready to go..."
'    ? str$(index)
    '-----------------------------------------------------------
    'Array is now filled with all 6 letter words.
    'Next, see if "ACACIA" has any other words that are 1 letter different...
    '-----------------------------------------------------------
    blank(1) = &b11111111111111111111111111100000  'first make a mask to test each of 6 1-letter differences
    blank(2) = &b11111111111111111111110000011111
    blank(3) = &b11111111111111111000001111111111
    blank(4) = &b11111111111100000111111111111111
    blank(5) = &b11111110000011111111111111111111
    blank(6) = &b11000001111111111111111111111111

    index = 0
    FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with THINK, test it for any 1-letter-different matches
       IF wordOrig6(ii3) = "THINK" THEN
       FOR ii2 = 1 TO 5
          acacia(ii2) = word6(ii3) AND blank(ii2)
          FOR ii = 0 TO %NUMBERofWORDS
             IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                IF ii <> ii3 THEN                     'eliminate match with itself
                   a1(index) = word6(ii)
                   as1(index) = wordOrig6(ii) & "THINK"
                   INCR index
                END IF
             END IF
          NEXT
       NEXT
       END IF
    NEXT

   index2 = 0
    FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with BRAIN, test it for any 1-letter-different matches
       IF wordOrig6(ii3) = "BRAIN" THEN
       FOR ii2 = 1 TO 5
          acacia(ii2) = word6(ii3) AND blank(ii2)
          FOR ii = 0 TO %NUMBERofWORDS
             IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                IF ii <> ii3 THEN                     'eliminate match with itself
                   b1(index2) = word6(ii)
                   bs1(index2) = wordOrig6(ii) & "BRAIN"
                   INCR index2
                END IF
             END IF
          NEXT
       NEXT
       END IF
    NEXT

    ? JOIN$(as1(), "  ") & $CRLF & JOIN$(bs1(), "  ")

    '-----------------------------------------------------------
    'Now get second arrays of words that are 1 letter different from the previously found arrays...
    '-----------------------------------------------------------
    FOR ii4 = 0 TO index - 1
    FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with a1(), test it for any 1-letter-different matches
       IF word6(ii3) = a1(ii4) THEN
       FOR ii2 = 1 TO 5
          acacia(ii2) = word6(ii3) AND blank(ii2)
          FOR ii = 0 TO %NUMBERofWORDS
             IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                IF ii <> ii3 THEN                     'eliminate match with itself
                   a2(index3) = word6(ii)
                   as2(index3) = wordOrig6(ii) & as1(ii4)
                   INCR index3
                END IF
             END IF
          NEXT
       NEXT
       END IF
    NEXT
    NEXT

    FOR ii4 = 0 TO index2 - 1
    FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with b(1), test it for any 1-letter-different matches
       IF word6(ii3) = b1(ii4) THEN
       FOR ii2 = 1 TO 5
          acacia(ii2) = word6(ii3) AND blank(ii2)
          FOR ii = 0 TO %NUMBERofWORDS
             IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                IF ii <> ii3 THEN                     'eliminate match with itself
                   b2(index4) = word6(ii)
                   bs2(index4) = wordOrig6(ii) & bs1(ii4)
                   INCR index4
                END IF
             END IF
          NEXT
       NEXT
       END IF
    NEXT
    NEXT

'eliminate duplicates in a2() and as2() < this is the human readable version of a2()
    ARRAY SORT a2(), TAGARRAY as2()
    ii2 = 0
    FOR ii = 0 TO 1000 - 1
       IF a2(ii) = 0 THEN ITERATE FOR
       IF a2(ii) = a2(ii + 1) THEN
          ITERATE FOR
       ELSE
          a2(ii2) = a2(ii)
          as2(ii2) = as2(ii)
          INCR ii2
       END IF
    NEXT
    IF a2(999) <> a2(1000) THEN 'handle last element
       a2(ii2) = a2(1000)
       as2(ii2) = as2(1000)
       INCR ii2
    END IF
    FOR ii = ii2 TO 1000
       a2(ii) = 0
       as2(ii) = ""
    NEXT
'eliminate duplicates in b2() and bs2() < this is the human readable version of b2()
    ARRAY SORT b2(), TAGARRAY bs2()
    ii2 = 0
    FOR ii = 0 TO 1000 - 1
       IF b2(ii) = 0 THEN ITERATE FOR
       IF b2(ii) = b2(ii + 1) THEN
          ITERATE FOR
       ELSE
          b2(ii2) = b2(ii)
          bs2(ii2) = bs2(ii)
          INCR ii2
       END IF
    NEXT
    IF b2(999) <> b2(1000) THEN 'handle last element (1000)
       b2(ii2) = b2(1000)
       bs2(ii2) = bs2(1000)
       INCR ii2
    END IF
    FOR ii = ii2 TO 1000
       b2(ii) = 0
       bs2(ii) = ""
    NEXT
    ? JOIN$(as2(), "  ") & $CRLF & JOIN$(bs2(), "  ")

    '-----------------------------------------------------------
    'Now get third arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    FOR ii4 = 0 TO index3 - 1
    FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with a2(), test it for any 1-letter-different matches
       IF word6(ii3) = a2(ii4) THEN
       FOR ii2 = 1 TO 5
          acacia(ii2) = word6(ii3) AND blank(ii2)
          FOR ii = 0 TO %NUMBERofWORDS
             IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                IF ii <> ii3 THEN                     'eliminate match with itself
                   a3(index5) = word6(ii)
                   as3(index5) = wordOrig6(ii) & as2(ii4)
                   INCR index5
                END IF
             END IF
          NEXT
       NEXT
       END IF
    NEXT
    NEXT

    FOR ii4 = 0 TO index4 - 1
    FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with b2(), test it for any 1-letter-different matches
       IF word6(ii3) = b2(ii4) THEN
       FOR ii2 = 1 TO 5
          acacia(ii2) = word6(ii3) AND blank(ii2)
          FOR ii = 0 TO %NUMBERofWORDS
             IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                IF ii <> ii3 THEN                     'eliminate match with itself
                   b3(index6) = word6(ii)
                   bs3(index6) = wordOrig6(ii) & bs2(ii4)
                   INCR index6
                END IF
             END IF
          NEXT
       NEXT
       END IF
    NEXT
    NEXT

'eliminate duplicates in a3() and as3() < this is the human readable version of a3()
    ARRAY SORT a3(), TAGARRAY as3()
    ii2 = 0
    FOR ii = 0 TO 1000 - 1
       IF a3(ii) = 0 THEN ITERATE FOR
       IF a3(ii) = a3(ii + 1) THEN
          ITERATE FOR
       ELSE
          a3(ii2) = a3(ii)
          as3(ii2) = as3(ii)
          INCR ii2
       END IF
    NEXT
    IF a3(999) <> a3(1000) THEN 'handle last element
       a3(ii2) = a3(1000)
       as3(ii2) = as3(1000)
       INCR ii2
    END IF
    FOR ii = ii2 TO 1000
       a3(ii) = 0
       as3(ii) = ""
    NEXT
'eliminate duplicates in b3() and bs3() < this is the human readable version of b3()
    ARRAY SORT b3(), TAGARRAY bs3()
    ii2 = 0
    FOR ii = 0 TO 1000 - 1
       IF b3(ii) = 0 THEN ITERATE FOR
       IF b3(ii) = b3(ii + 1) THEN
          ITERATE FOR
       ELSE
          b3(ii2) = b3(ii)
          bs3(ii2) = bs3(ii)
          INCR ii2
       END IF
    NEXT
    IF b3(999) <> b3(1000) THEN 'handle last element (1000)
       b3(ii2) = b3(1000)
       bs3(ii2) = bs3(1000)
       INCR ii2
    END IF
    FOR ii = ii2 TO 1000
       b3(ii) = 0
       bs3(ii) = ""
    NEXT
    ? JOIN$(as3(), "  ") & $CRLF & JOIN$(bs3(), "  ")
    
    FOR ii = 1 TO 200           'slow logic here just for demo purposes. If 4 of 5 letters are equal, just 1 change completes.
       FOR ii2 = 1 TO 200
          IF ASC(as3(ii), 1) = ASC(bs3(ii2), 1) AND ASC(as3(ii), 2) = ASC(bs3(ii2), 2) AND ASC(as3(ii), 3) = ASC(bs3(ii2), 3) _
          AND ASC(as3(ii), 4) = ASC(bs3(ii2), 4) THEN
             ? MID$(as3(ii), 16) & MID$(as3(ii), 11, 5) & MID$(as3(ii), 6, 5) & MID$(as3(ii), 1, 5) & bs3(ii2)
             GOTO done
          END IF
       NEXT
    NEXT
    done:

END FUNCTION