Announcement

Collapse
No announcement yet.

Word Progression Puzzle

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

    #21
    You are quite right that :
    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.
    The program doesn't know it. The idea is to check what words CHINK produces, then try the next word that is of the same generation/level that CHINK is part of, which you did, with the THANK= SHANK THANE. Then you tried Thick which gave you TRICK. If after each new generated word you were doing some sort of matching at the time you reached TRICK your program would know that it had matched the second letter of the target word. If you were doing a different word chain, you might not find a word for three or four levels that match a letter from the target word and your program is going to be have to be able to handle that scenario. Back to this chain. On finding a letter that matches a letter by position in the target word, you should bring your searching to a screeching halt, then go to your target word. At this point you only have to generate words that replace four positions of the target word. The first, third, fourth, and fifth letters can be changed to form words. Leave the second letter alone because you already have a match for it. As luck(design) would have it, changing the B in BRAIN to some other letter is going to give you your second match.There are other words besides TRAIN, like DRAIN, GRAIN but only TRAIN will give you that second match.
    Those two matches(first the R, then the T) are telling you, and you should be getting the computer to take advantage of those matches, that it is on the right track.
    If you switch back and forth from the Start word to the Target word( or their parent/child) your next step would be to go back to the word TRICK and generate the list of words from TRICK that do not remove the T or the R, if possible. There is no need, in this instance, at this point to check the other words from THICK's generation. The THINE THING and THINS can be latered.
    So how did we get past the A in THANK which matches the A in BRAIN. Well your program should have taken you to a dead end, or another CHAIN.(I just noticed it.) I'll bring up POINT B later.

    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
    Where we are in our current train of thought hopefully is as follows
    THINK
    --THICK 'should have gone on a wild goose chase? with THANK first
    ----TRICK 'match second letter of target word
    ------ 'searching for words that match the last three letters
    --------
    ----------
    ------------TRAIN 'match first letter of start word
    --------------BRAIN
    The trick to moving on to the next level is making a match, or failing that, exhausting all possibles.

    POINT B
    What if there is more than one chain? Do you want the shortest. The first chain you find may not be the shortest. It may even that there is no chain. Is there a maximum number of chains. Is there a maximum number of words twixt the Start word and the Target word?

    Rod
    Rod
    In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

    Comment


      #22
      John,

      That code is fast! I mean REALLY FAST! Only .02 Seconds to solve (after adding a timer and remming the msgboxes.). WOW!

      Great job.

      (a little later)

      Actually the elapsed time is in the .3 seconds area, not .02. Before I didn't start the timer until after the file was read. Still mighty impressive though. Note also, the time was/is taken after it was run a few times so the file was in the cache and not read from disk.

      ==============================
      "Springs mingle with streams,
      streams with the river,
      rivers with the ocean,
      oceans with the clouds."
      ==============================
      Last edited by Gösta H. Lovgren-2; 18 Feb 2008, 06:16 PM. Reason: a little later
      It's a pretty day. I hope you enjoy it.

      Gösta

      JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
      LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

      Comment


        #23
        Originally posted by Rodney Hicks View Post
        ...
        POINT B
        What if there is more than one chain? Do you want the shortest. The first chain you find may not be the shortest.
        Doesn't make any difference I think. The object is to connect the two words. There may be multiple ways to connect. The puzzle only gives the starting word and the result word. It's up to the solver to connect them.

        It may even that there is no chain.
        If there is no chain there is no point to the puzzle, other than deliberate frustration.

        Is there a maximum number of chains. Is there a maximum number of words twixt the Start word and the Target word?
        The puzzle is as stated in the beginning. It (or any other I've seen) doesn't care how many chains can be made, only the connection be made changing one letter at a time.
        It's a pretty day. I hope you enjoy it.

        Gösta

        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

        Comment


          #24
          One thing about the speed: I'd suggest saving the dictionary in converted format, then reading it all in at once to the dictionary array when the program starts. The time per conversion will then drop back to the fast couple hundredths. (And even reading it in will be way faster than creating it like I am now; I'd think it would seem instantaneous).

          btw, do you think it'll be of any use to you, or is it too much spaghetti?

          Comment


            #25
            Spaghetti? Way too much meat(balls) in her to call it mere pasta.

            I've spent the evening creating a GUI for it, I'm so impressed. My idea of "fun". (Well, one of them anyway.) Tomorrow I'll spend some time trying to decipher it and try converting it to use variables. (Good luck to me doing that.) I'm really psyched, even amazed, at how quickly (and simply) you came up with the answer, John.

            Anyway, here's the GUI. I *think* it'll run as is. There's a lot of unnecessary stuff (it's from a template I use to start a program with) but I think I have everything specific to my machine commented out.

            '
            Code:
            #Compile Exe
            #Dim All
             
            '------------------------------------------------------------------------------
            '   ** Includes **
            '------------------------------------------------------------------------------
            #Include "WIN32API.INC"
             
            '#Include "C:\Power Basic\Includes\clipboard.inc"
            '#Include "C:\Power Basic\Includes\Common_Constants.inc"
            '#Include "c:\Power Basic\Includes\Fonts.inc"
            '#Include "c:\Power Basic\Includes\Colors.inc"
            ' #Include "C:\Power Basic\Includes\Common_Macros.inc" 
            '#Include "C:\Power Basic\Includes\process_memoryinfo.inc"  
            '#Include "C:\Power Basic\Includes\Common_Subs_Funcs.inc"
            '#Resource "C:\Power Basic\Icons\Icons.pbr"
            '#Include "C:\Power Basic\Includes\File_Exist.inc"
                  'In Common_Locals
            '#Include "C:\Power Basic\Includes\Variables_Common_to_All_Programs.inc"
             
             
             
            '------------------------------------------------------------------------------
             
            '------------------------------------------------------------------------------
            '   ** Constants **
            '------------------------------------------------------------------------------
            %Box_Height = 20   
            %Char_Width = 5    
             
             
            %Btn_01     = 1002 
            %Word_Start = 1003 
            %Word_Done  = 1004 
             
            '------------------------------------------------------------------------------
             
            Union sixMax
               cLine As String * 4
               cLong As Long
            End Union
             
             
            '------------------------------------------------------------------------------
             
            '------------------------------------------------------------------------------
            '   ** Macros **
            '------------------------------------------------------------------------------
            Macro m_Binary_Open
               fnum = FreeFile
                Open fn$ For Binary As fnum
                 flen = Lof(fnum)   
             
               Fle$ = Space$(flen)'create a space to put the file
               Get fnum,,fle$  'put the file in the space
               Close fnum 
               m$ = fn$: m_Err_Msg 'Msgbox if an error
            End Macro
            '
            Macro m_Err_Msg 
             If Err Then 
                Stile = %MB_SYSTEMMODAL Or _          
                        %MB_ICONERROR Or _
                        %MB_ICONWARNING  
             
               ? m$ & $CrLf & $CrLf & Using$("# ", Err) & Error$(Err),_
                 Stile, _
                 " In " & FuncName$ 
             End If  
            End Macro 
            '                  
            Macro mb   
              MsgBox m$ & $CrLf & $CrLf & m1$, _
                    %MB_TASKMODAL, _
                    " In " & FuncName$ 
              Reset m$, m1$
            End Macro      
            '
             
            '------------------------------------------------------------------------------
             
             
            '------------------------------------------------------------------------------
            '   ** Globals **
            '------------------------------------------------------------------------------
                Global hDlg  As Dword
            '------------------------------------------------------------------------------
             
             
             
            '------------------------------------------------------------------------------
            '   ** 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 %Btn_01
                              Call WPP_Answer '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
                 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 WPP_Answer
            'Union sixMax
            '   cLine As String * 4
            '   cLong As Long
            'End Union
             
            '  Common_Locals
              Local lineo As String
              Local ii, ii2, ii3, ii4, index, index2, index3, index4, index5, index6, endLoop As Long
              Local compressLineo As sixMax
             
              Local g_Timer#, t$, Reps&
              Local Number_of_Words&, Words_In_File&, Word_Len&
              Local fn$, fle$, fnum&, flen&, Stile&, m$, m1$ 'used in macros
              Local First_Word$, Last_Word$, total_Words_in_File$, sp$
             
              Control Get Text hDlg, %Word_Start To First_Word$
              Control Get Text hDlg, %Word_Done  To Last_Word$
             
              Number_of_Words = 6919
              Word_Len = 5
             
              fn$ = CurDir$ & "\Words.txt"
               m_Binary_Open  'puts file in fle$
                Words_In_File = ParseCount(fle$, $Lf)         
                 Close
                'total_Words_in_File$ =  $CrLf & Using$("#,###  Words in File", Words_In_File) & $CrLf 
             
                g_timer# = Timer
             
             
              Dim word6(Number_of_Words) As Long, wordOrig6(Number_of_Words) 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 CurDir$ & "\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 Number_of_Words                  '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 Number_of_Words
                         Incr Reps
                         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 Number_of_Words                  '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 Number_of_Words
                         Incr Reps
                         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 Number_of_Words                  '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 Number_of_Words
                         Incr Reps
                         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 Number_of_Words                  '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 Number_of_Words
                         Incr Reps
                         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
                   Incr Reps
                   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
                   Incr Reps
                   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
                   Incr Reps
                   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
                   Incr Reps
                   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 Number_of_Words                  'starting with a2(), test it for any 1-letter-different matches
                   If word6(ii3) = a2(ii4) Then
                   For ii2 = 1 To 5
                     Incr Reps
                      acacia(ii2) = word6(ii3) And blank(ii2)
                      For ii = 0 To Number_of_Words
                         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 Number_of_Words                  '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 Number_of_Words
                        Incr Reps
                         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
                 Incr Reps
                 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
                   Incr Reps
                   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
                   Incr Reps
                   b3(ii) = 0
                   bs3(ii) = ""
                Next
                '? t$ '& 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
                      Incr Reps
                      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
                        GoTo done
                      End If
                   Next
                Next
             
            done:
             
               sp$ = " - "
               Reset t$
               EndLoop = 1 'EndLoop not being used anymore so use again
               While Len(t$) < Len(bs3(ii2))'strip last words
                 t$ = t$ & sp$ & Mid$(bs3(ii2), EndLoop, Word_Len) & $CrLf 
                 EndLoop = EndLoop + Word_Len
               Wend
            '   ? t$
               t$ = t$ & sp$ & UCase$(Last_Word$) & $CrLf & _
                    Last_Word$
             
                m1$ = Using$("#,###  Words in File", Words_In_File) & $CrLf &  _
                      Using$("#, Operations", Reps) &  $CrLf & _
                      Using$("Took .## Seconds", Timer - G_Timer#) 
             
                m$ =  First_Word$ & $CrLf & _
                      sp$ & Mid$(as3(ii), 16, Word_len) & $CrLf & _
                      sp$ & Mid$(as3(ii), 11, 5) & $CrLf & _
                      sp$ & Mid$(as3(ii), 6, 5) & $CrLf & _
                      sp$ & Mid$(as3(ii), 1, 5) & $CrLf & _
                      t$ 
             
                mb      
             
             
                Close 'case file left open
             
            End Sub 
            '*************************************************************
             
            '------------------------------------------------------------------------------
            '   ** Dialogs **
            '------------------------------------------------------------------------------
            Function Main_Dialog(ByVal hParent As Dword) As Long
               'Common_Locals
               Local Row&, Col&, col1&, Wdth&, Hght&, tb_Len&, lbl$, m$, m1$
                 Wdth = 300
                 Hght = 150
             
                Dialog New Pixels, hDlg, "Word Progression Solver ", _
                       , , Wdth, Hght, _
                       To hDlg
             
                Row = 12
                Col = 10                
             
                lbl$ = "Solving Algorithm " & $CrLf & _
                       "   courtesy of:   " & $CrLf & _
                       "   John Gleason   " & $CrLf & _
                       "       and        " & $CrLf & _
                       " PowerBASIC Forums"  
             
             
                Control Add Label, hDlg, -1, lbl$, _
                     Col + 175, Row, 125, %Box_Height * 5
             
             
             
             
                lbl$ = "  Starting Word " 
                  tb_len = Len(lbl$) * 5
             
                Control Add Label, hDlg, -1, lbl$, _
                     Col, Row, tb_len, %Box_Height
                  Control Add TextBox, hDlg, %Word_Start, "Think", _
                      Col + tb_len + 5, Row, tb_len, %Box_Height
             
                RSet lbl$ = "Finished Word "
                Row = Row + (%Box_Height * 2)
                Control Add Label, hDlg, -1, lbl$, _
                     Col, Row, tb_len, %Box_Height
                  Control Add TextBox, hDlg, %Word_Done, "Brain", _
                      Col + tb_len + 5, Row, tb_len, %Box_Height
             
             
                lbl$ = "Solve Word Progression"
                Row = Row + (%Box_Height * 2)
                Control Add Button,  hDlg, %Btn_01, lbl$, _
                    Col, Row, _
                    Wdth - 20,  %Box_Height * 2
             
             
             
                Local lRslt&
                Dialog Show Modal hDlg, Call Dialog_CB_Processor To lRslt
             
             
                Function = lRslt
            End Function
            '------------------------------------------------------------------------------
             
            '------------------------------------------------------------------------------
            '------------------------------------------------------------------------------
            '   ** Main Application Entry Point **
            '------------------------------------------------------------------------------
            Function PBMain()
                Main_Dialog %HWND_DESKTOP
            End Function
            '------------------------------------------------------------------------------
             
             
            '
            It's a pretty day. I hope you enjoy it.

            Gösta

            JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
            LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

            Comment


              #26
              Gösta
              I compiled and ran the program as it was, no problems.Except, you need %WS_SYSMENU so I can close the first dialog. I will add it myself of course. Looking good. Now, can I assume that when your finished you'll be able to enter any two five letter words and it will find the chain?
              Rod
              Rod
              In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

              Comment


                #27
                Originally posted by Rodney Hicks View Post
                Gösta
                I compiled and ran the program as it was, no problems.Except, you need %WS_SYSMENU so I can close the first dialog. I will add it myself of course.
                I will as well. I get so used to closing by Alt F4 when I'm working I forget about it.

                Looking good. Now, can I assume that when your finished you'll be able to enter any two five letter words and it will find the chain?
                Rod
                Kind of dangerous to assume anything where my programming is concerned {grin} If I can figure out John's code what I hope to do, it will: take any two equal length words (won't accept unequal lengths) and create a chain.

                Haven't started on John's code yet (other than shown) but as an example I built a file of the Word list sorted by size
                (ie.
                Data 2, AB
                ...
                Data 28, ANTIDISESTABLISHMENTARIANISM
                )

                What's in my head is to have a teacher input a set of spelling words, then print an "answer chain". If the chain isn't too long or complicated, then the set could be given as a "fun" assignment. (ie. HIT to BAR for first graders)

                My wife was a K-4 teacher for 32 years out of 40 possible (she took 8 off to raise our kids) and I used to write grade level software for her (used a Radio Shack CoCo with tape drive & a small bw tv monitor in the beginning). The kids loved it. And this looks like it would be a great addition to that arsenal.

                ===============================
                "I don't even butter my bread;
                I consider that cooking."
                Katherine Cebrian
                ===============================
                Last edited by Gösta H. Lovgren-2; 19 Feb 2008, 07:09 AM.
                It's a pretty day. I hope you enjoy it.

                Gösta

                JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                Comment


                  #28
                  Now, can I assume that when your finished you'll be able to enter any two five letter words and it will find the chain?
                  Below I updated my previous code to work beyond the THINK-BRAIN example. It finds only up to 8-word sequences, and takes only 5-letter words, but it could be modified without too much work I think to do 6-letter or 4-letter words. Six letters is maximum without a pretty major rework.

                  It's possible some glitch may turn up in there tho, causing it to not find a sequence or err some other way. I'd actually be surprised if some kind of problem didn't turn up.

                  added later: found a couple bugs and increased last array size because was getting GPF occasionally.

                  Code:
                  #COMPILE EXE
                  #DIM ALL
                  
                  UNION sixMax
                     cLine AS STRING * 4
                     cLong AS LONG
                  END UNION
                  
                  %NUMBERofWORDS = 6919
                  %LASTaRRAYsIZE = 3000            'if there is a GPF, try making this equate larger
                  
                  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, inWord, outWord, sTemp AS STRING
                    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(%LASTaRRAYsIZE) AS LONG
                    DIM b1(100) AS LONG, b2(1000) AS LONG, b3(%LASTaRRAYsIZE) AS LONG
                    DIM as1(100) AS STRING, as2(1000) AS STRING, as3(%LASTaRRAYsIZE) AS STRING
                    DIM bs1(100) AS STRING, bs2(1000) AS STRING, bs3(%LASTaRRAYsIZE) 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 13000
                         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
                  
                      inWord  = UCASE$("glass")
                      outWord = UCASE$("drink")
                      index = 0
                      FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with inWord, test it for any 1-letter-different matches
                         IF wordOrig6(ii3) = inWord 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) & inWord
                                     INCR index
                                  END IF
                               END IF
                            NEXT
                         NEXT
                         END IF
                      NEXT
                  
                     index2 = 0
                      FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with outWord, test it for any 1-letter-different matches
                         IF wordOrig6(ii3) = outWord 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) & outWord
                                     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(), "  ")
                  
                      FOR ii = 1 TO 1000          'slow logic here just for demo purposes. If 4 of 5 letters are equal, just 1 change completes.
                                                  'redo (someday) for speed using previous test for 1-letter differences as done above.
                         IF ASC(as2(ii)) < 65 THEN EXIT FOR
                         FOR ii2 = 1 TO 1000
                            IF ASC(bs2(ii2)) < 65 THEN EXIT FOR
                            IF ASC(as2(ii), 1) = ASC(bs2(ii2), 1) AND ASC(as2(ii), 2) = ASC(bs2(ii2), 2) AND ASC(as2(ii), 3) = ASC(bs2(ii2), 3) _
                               AND ASC(as2(ii), 4) = ASC(bs2(ii2), 4) OR _
                               ASC(as2(ii), 2) = ASC(bs2(ii2), 2) AND ASC(as2(ii), 3) = ASC(bs2(ii2), 3) AND ASC(as2(ii), 4) = ASC(bs2(ii2), 4) _
                               AND ASC(as2(ii), 5) = ASC(bs2(ii2), 5) OR _
                               ASC(as2(ii), 1) = ASC(bs2(ii2), 1) AND ASC(as2(ii), 3) = ASC(bs2(ii2), 3) AND ASC(as2(ii), 4) = ASC(bs2(ii2), 4) _
                               AND ASC(as2(ii), 5) = ASC(bs2(ii2), 5) OR _
                               ASC(as2(ii), 1) = ASC(bs2(ii2), 1) AND ASC(as2(ii), 2) = ASC(bs2(ii2), 2) AND ASC(as2(ii), 4) = ASC(bs2(ii2), 4) _
                               AND ASC(as2(ii), 5) = ASC(bs2(ii2), 5) OR _
                               ASC(as2(ii), 1) = ASC(bs2(ii2), 1) AND ASC(as2(ii), 2) = ASC(bs2(ii2), 2) AND ASC(as2(ii), 3) = ASC(bs2(ii2), 3) _
                               AND ASC(as2(ii), 5) = ASC(bs2(ii2), 5) THEN
                                  sTemp =  MID$(as2(ii), 16) & MID$(as2(ii), 11, 5) & MID$(as2(ii), 6, 5) & MID$(as2(ii), 1, 5) & bs2(ii2)
                                  IF ASC(sTemp) > 32 THEN ? sTemp
                  '            GOTO done
                            END IF
                         NEXT
                      NEXT
                      '-----------------------------------------------------------
                      '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 %LASTaRRAYsIZE - 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(%LASTaRRAYsIZE - 1) <> a3(%LASTaRRAYsIZE) THEN 'handle last element
                         a3(ii2) = a3(%LASTaRRAYsIZE)
                         as3(ii2) = as3(%LASTaRRAYsIZE)
                         INCR ii2
                      END IF
                      FOR ii = ii2 TO %LASTaRRAYsIZE
                         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 %LASTaRRAYsIZE - 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(%LASTaRRAYsIZE - 1) <> b3(%LASTaRRAYsIZE) THEN 'handle last element (1000)
                         b3(ii2) = b3(%LASTaRRAYsIZE)
                         bs3(ii2) = bs3(%LASTaRRAYsIZE)
                         INCR ii2
                      END IF
                      FOR ii = ii2 TO %LASTaRRAYsIZE
                         b3(ii) = 0
                         bs3(ii) = ""
                      NEXT
                      ? JOIN$(as3(), "  ")
                      ? JOIN$(bs3(), "  ")
                  
                      FOR ii = 0 TO %LASTaRRAYsIZE - 1   'slow logic here just for demo purposes. If 4 of 5 letters are equal, just 1 change completes.
                         IF ASC(as3(ii)) < 65 THEN EXIT FOR
                         FOR ii2 = 0 TO %LASTaRRAYsIZE - 1
                            IF ASC(bs3(ii2)) < 65 THEN EXIT FOR
                            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) OR _
                               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) _
                               AND ASC(as3(ii), 5) = ASC(bs3(ii2), 5) OR _
                               ASC(as3(ii), 1) = ASC(bs3(ii2), 1) AND ASC(as3(ii), 3) = ASC(bs3(ii2), 3) AND ASC(as3(ii), 4) = ASC(bs3(ii2), 4) _
                               AND ASC(as3(ii), 5) = ASC(bs3(ii2), 5) OR _
                               ASC(as3(ii), 1) = ASC(bs3(ii2), 1) AND ASC(as3(ii), 2) = ASC(bs3(ii2), 2) AND ASC(as3(ii), 4) = ASC(bs3(ii2), 4) _
                               AND ASC(as3(ii), 5) = ASC(bs3(ii2), 5) OR _
                               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), 5) = ASC(bs3(ii2), 5) THEN
                                  IF LEFT$(as3(ii), 5) = LEFT$(bs3(ii2), 5) THEN bs3(ii2) = MID$(bs3(ii2), 6)
                                  ? MID$(as3(ii), 16) & MID$(as3(ii), 11, 5) & MID$(as3(ii), 6, 5) & MID$(as3(ii), 1, 5) & bs3(ii2)
                            END IF
                         NEXT
                      NEXT
                  
                  END FUNCTION
                  Last edited by John Gleason; 19 Feb 2008, 08:06 AM.

                  Comment


                    #29
                    'Nix on this. It seems there's an 8,192 limit of Data elements. (oh well). I had intended to Include the file so as to be able to just have one .exe to run with no other files.

                    Leaving it just to demo the concept.

                    **********************************************************
                    Here's the sub to create the Data file. Just drop it in the original code, Call it from PBMain to build the file, then Rem the Call.
                    Code:
                    '------------------------------------------------------------------------------
                    'Create data statements for use later
                    'builds a file sorted by length ie "Data 2, AB"
                    Sub Data_Words_Create
                      Common_Locals
                      m_Fill_G_Words_Array   
                       ReDim tmp(LBound(g_words) To UBound(g_Words)) As String * 30 'longest word
                      'strip words of ascii values
                      For ctr = LBound(g_words) To UBound(g_Words)
                         RSet tmp$(Ctr)= Mid$(g_Words$(ctr), 7)
                      Next ctr           
                      Array Sort tmp$() 'now sort according to string length
                      fn$ = CurDir$ & "\Data_Words.txt"
                       m_Output_Open    
                     
                      For ctr = LBound(g_words) To UBound(g_Words)
                         t$ = Trim$(tmp$(ctr)) 'convenience
                         If Asc(t$) > 64 Then 'case of blank lines
                            Incr ctr1
                            pf Using$("Data ##", Len(t$)) & ", " & _
                               Trim$(tmp$(ctr))
                         End If 
                      Next ctr
                      m$ = Using$("#, elements #, Data Words", UBound(g_Words), ctr1): mb
                      Close
                      Erase tmp$ 'don't need it any more
                    End Sub
                    And here's a new Common_Locals Macro jic I added anything from/to the original when writing the Sub.

                    Code:
                    '------------------------------------------------------------------------------
                    Macro Common_Locals
                      Local Ctr&, ctr1&
                      Local g_Timer#, t$, Reps&
                      Local Number_of_Words&, Words_In_File&, Word_Len&
                      Local fn$, fle$, fnum&, flen&, Stile&, m$, m1$ 'used in macros
                      Local First_Word$, Last_Word$, total_Words_in_File$, sp$
                      Local temp$, t1$
                    End Macro
                    '
                    Last edited by Gösta H. Lovgren-2; 19 Feb 2008, 07:46 AM.
                    It's a pretty day. I hope you enjoy it.

                    Gösta

                    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                    Comment


                      #30
                      I couldn't quit messing with it, so I upped it now to ten word sequences max, and improved the output formatting.

                      Code:
                      #COMPILE EXE
                      #DIM ALL
                      
                      UNION sixMax
                         cLine AS STRING * 4
                         cLong AS LONG
                      END UNION
                      
                      %NUMBERofWORDS = 6919
                      %LASTaRRAYsIZE = 3000            'if there is a GPF, try making this equate larger
                      %LASTaRRAYsIZE2= 12000           'if there is a GPF, try making this equate larger
                      
                      FUNCTION PBMAIN () AS LONG
                        LOCAL lineo AS STRING, ii, ii2, ii3, ii4, index, index2, index3, index4 AS LONG
                        LOCAL index5, index6, index7, index8, endLoop AS LONG
                        LOCAL compressLineo AS sixMax, inWord, outWord, sTemp AS STRING
                        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(%LASTaRRAYsIZE) AS LONG, a4(%LASTaRRAYsIZE2) AS LONG
                        DIM b1(100) AS LONG, b2(1000) AS LONG, b3(%LASTaRRAYsIZE) AS LONG, b4(%LASTaRRAYsIZE2) AS LONG
                        DIM as1(100) AS STRING, as2(1000) AS STRING, as3(%LASTaRRAYsIZE) AS STRING, as4(%LASTaRRAYsIZE2) AS STRING
                        DIM bs1(100) AS STRING, bs2(1000) AS STRING, bs3(%LASTaRRAYsIZE) AS STRING, bs4(%LASTaRRAYsIZE2) 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 13000
                             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)& STR$(ii2)
                          '-----------------------------------------------------------
                          '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
                      
                          inWord  = UCASE$("torus")
                          outWord = UCASE$("break")
                      '    inWord  = UCASE$("hours")
                      '    outWord = UCASE$("timer")
                      '    inWord  = UCASE$("baker")
                      '    outWord = UCASE$("hoofs")
                          index = 0
                          FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with inWord, test it for any 1-letter-different matches
                             IF wordOrig6(ii3) = inWord 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) & inWord
                                         INCR index
                                      END IF
                                   END IF
                                NEXT
                             NEXT
                             END IF
                          NEXT
                      
                         index2 = 0
                          FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with outWord, test it for any 1-letter-different matches
                             IF wordOrig6(ii3) = outWord 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) & outWord
                                         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(), "  ")
                      
                          FOR ii = 1 TO 1000          'slow logic here just for demo purposes. If 4 of 5 letters are equal, just 1 change completes.
                                                      'redo (someday) for speed using previous test for 1-letter differences as done above.
                             IF ASC(as2(ii)) < 65 THEN EXIT FOR
                             FOR ii2 = 1 TO 1000
                                IF ASC(bs2(ii2)) < 65 THEN EXIT FOR
                                IF ASC(as2(ii), 1) = ASC(bs2(ii2), 1) AND ASC(as2(ii), 2) = ASC(bs2(ii2), 2) AND ASC(as2(ii), 3) = ASC(bs2(ii2), 3) _
                                   AND ASC(as2(ii), 4) = ASC(bs2(ii2), 4) OR _
                                   ASC(as2(ii), 2) = ASC(bs2(ii2), 2) AND ASC(as2(ii), 3) = ASC(bs2(ii2), 3) AND ASC(as2(ii), 4) = ASC(bs2(ii2), 4) _
                                   AND ASC(as2(ii), 5) = ASC(bs2(ii2), 5) OR _
                                   ASC(as2(ii), 1) = ASC(bs2(ii2), 1) AND ASC(as2(ii), 3) = ASC(bs2(ii2), 3) AND ASC(as2(ii), 4) = ASC(bs2(ii2), 4) _
                                   AND ASC(as2(ii), 5) = ASC(bs2(ii2), 5) OR _
                                   ASC(as2(ii), 1) = ASC(bs2(ii2), 1) AND ASC(as2(ii), 2) = ASC(bs2(ii2), 2) AND ASC(as2(ii), 4) = ASC(bs2(ii2), 4) _
                                   AND ASC(as2(ii), 5) = ASC(bs2(ii2), 5) OR _
                                   ASC(as2(ii), 1) = ASC(bs2(ii2), 1) AND ASC(as2(ii), 2) = ASC(bs2(ii2), 2) AND ASC(as2(ii), 3) = ASC(bs2(ii2), 3) _
                                   AND ASC(as2(ii), 5) = ASC(bs2(ii2), 5) THEN
                                      IF LEFT$(as2(ii), 5) = LEFT$(bs2(ii2), 5) THEN bs2(ii2) = MID$(bs2(ii2), 6)
                                      sTemp = SPACE$(36)
                                      MID$(sTemp, 1)  = MID$(as2(ii), 11, 5)
                                      MID$(sTemp, 07) = MID$(as2(ii), 06, 5)
                                      MID$(sTemp, 13) = MID$(as2(ii), 01, 5)
                                      MID$(sTemp, 19) = MID$(bs2(ii2), 01, 5)
                                      MID$(sTemp, 25) = MID$(bs2(ii2), 06, 5)
                                      MID$(sTemp, 31) = MID$(bs2(ii2), 11, 5)
                                      ? RTRIM$(sTemp)
                                END IF
                             NEXT
                          NEXT
                          '-----------------------------------------------------------
                          '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 %LASTaRRAYsIZE - 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(%LASTaRRAYsIZE - 1) <> a3(%LASTaRRAYsIZE) THEN 'handle last element
                             a3(ii2) = a3(%LASTaRRAYsIZE)
                             as3(ii2) = as3(%LASTaRRAYsIZE)
                             INCR ii2
                          END IF
                          FOR ii = ii2 TO %LASTaRRAYsIZE
                             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 %LASTaRRAYsIZE - 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(%LASTaRRAYsIZE - 1) <> b3(%LASTaRRAYsIZE) THEN 'handle last element (1000)
                             b3(ii2) = b3(%LASTaRRAYsIZE)
                             bs3(ii2) = bs3(%LASTaRRAYsIZE)
                             INCR ii2
                          END IF
                          FOR ii = ii2 TO %LASTaRRAYsIZE
                             b3(ii) = 0
                             bs3(ii) = ""
                          NEXT
                      '    ? JOIN$(as3(), "  ")
                      '    ? JOIN$(bs3(), "  ")
                      
                          FOR ii = 0 TO %LASTaRRAYsIZE - 1   'slow logic here just for demo purposes. If 4 of 5 letters are equal, just 1 change completes.
                             IF ASC(as3(ii)) < 65 THEN EXIT FOR
                             FOR ii2 = 0 TO %LASTaRRAYsIZE - 1
                                IF ASC(bs3(ii2)) < 65 THEN EXIT FOR
                                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) OR _
                                   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) _
                                   AND ASC(as3(ii), 5) = ASC(bs3(ii2), 5) OR _
                                   ASC(as3(ii), 1) = ASC(bs3(ii2), 1) AND ASC(as3(ii), 3) = ASC(bs3(ii2), 3) AND ASC(as3(ii), 4) = ASC(bs3(ii2), 4) _
                                   AND ASC(as3(ii), 5) = ASC(bs3(ii2), 5) OR _
                                   ASC(as3(ii), 1) = ASC(bs3(ii2), 1) AND ASC(as3(ii), 2) = ASC(bs3(ii2), 2) AND ASC(as3(ii), 4) = ASC(bs3(ii2), 4) _
                                   AND ASC(as3(ii), 5) = ASC(bs3(ii2), 5) OR _
                                   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), 5) = ASC(bs3(ii2), 5) THEN
                                      IF LEFT$(as3(ii), 5) = LEFT$(bs3(ii2), 5) THEN bs3(ii2) = MID$(bs3(ii2), 6)
                                      sTemp = SPACE$(48)
                                      MID$(sTemp, 1)  = MID$(as3(ii), 16, 5)
                                      MID$(sTemp, 07) = MID$(as3(ii), 11, 5)
                                      MID$(sTemp, 13) = MID$(as3(ii), 06, 5)
                                      MID$(sTemp, 19) = MID$(as3(ii), 01, 5)
                                      MID$(sTemp, 25) = MID$(bs3(ii2), 01, 5)
                                      MID$(sTemp, 31) = MID$(bs3(ii2), 06, 5)
                                      MID$(sTemp, 37) = MID$(bs3(ii2), 11, 5)
                                      MID$(sTemp, 43) = MID$(bs3(ii2), 16, 5)
                                      ? RTRIM$(sTemp)
                                END IF
                             NEXT
                          NEXT
                      
                          '-----------------------------------------------------------
                          'Now get fourth arrays of words that are 1 letter different from the last found arrays...
                          '-----------------------------------------------------------
                          FOR ii4 = 0 TO index5 - 1
                          FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with a2(), test it for any 1-letter-different matches
                             IF word6(ii3) = a3(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
                                         a4(index7) = word6(ii)
                                         as4(index7) = wordOrig6(ii) & as3(ii4)
                                         INCR index7
                                      END IF
                                   END IF
                                NEXT
                             NEXT
                             END IF
                          NEXT
                          NEXT
                      
                          FOR ii4 = 0 TO index6 - 1
                          FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with b2(), test it for any 1-letter-different matches
                             IF word6(ii3) = b3(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
                                         b4(index8) = word6(ii)
                                         bs4(index8) = wordOrig6(ii) & bs3(ii4)
                                         INCR index8
                                      END IF
                                   END IF
                                NEXT
                             NEXT
                             END IF
                          NEXT
                          NEXT
                      
                      'eliminate duplicates in a4() and as4() < this is the human readable version of a4()
                          ARRAY SORT a4(), TAGARRAY as4()
                          ii2 = 0
                          FOR ii = 0 TO %LASTaRRAYsIZE2 - 1
                             IF a4(ii) = 0 THEN ITERATE FOR
                             IF a4(ii) = a4(ii + 1) THEN
                                ITERATE FOR
                             ELSE
                                a4(ii2) = a4(ii)
                                as4(ii2) = as4(ii)
                                INCR ii2
                             END IF
                          NEXT
                          IF a4(%LASTaRRAYsIZE2 - 1) <> a4(%LASTaRRAYsIZE2) THEN 'handle last element
                             a4(ii2) = a4(%LASTaRRAYsIZE2)
                             as4(ii2) = as4(%LASTaRRAYsIZE2)
                             INCR ii2
                          END IF
                          FOR ii = ii2 TO %LASTaRRAYsIZE2
                             a4(ii) = 0
                             as4(ii) = ""
                          NEXT
                      'eliminate duplicates in b4() and bs4() < this is the human readable version of b4()
                          ARRAY SORT b4(), TAGARRAY bs4()
                          ii2 = 0
                          FOR ii = 0 TO %LASTaRRAYsIZE2 - 1
                             IF b4(ii) = 0 THEN ITERATE FOR
                             IF b4(ii) = b4(ii + 1) THEN
                                ITERATE FOR
                             ELSE
                                b4(ii2) = b4(ii)
                                bs4(ii2) = bs4(ii)
                                INCR ii2
                             END IF
                          NEXT
                          IF b4(%LASTaRRAYsIZE2 - 1) <> b4(%LASTaRRAYsIZE2) THEN 'handle last element (1000)
                             b4(ii2) = b4(%LASTaRRAYsIZE2)
                             bs4(ii2) = bs4(%LASTaRRAYsIZE2)
                             INCR ii2
                          END IF
                          FOR ii = ii2 TO %LASTaRRAYsIZE2
                             b4(ii) = 0
                             bs4(ii) = ""
                          NEXT
                      '   ? JOIN$(as4(), "  ")
                      '   ? JOIN$(bs4(), "  ")
                          ii3 = 0
                          FOR ii = 0 TO %LASTaRRAYsIZE2 - 1   'slow logic here just for demo purposes. If 4 of 5 letters are equal, just 1 change completes.
                             IF ASC(as4(ii)) < 65 THEN EXIT FOR
                             FOR ii2 = 0 TO %LASTaRRAYsIZE2 - 1
                                IF ASC(bs4(ii2)) < 65 THEN EXIT FOR
                                IF ASC(as4(ii), 1) = ASC(bs4(ii2), 1) AND ASC(as4(ii), 2) = ASC(bs4(ii2), 2) AND ASC(as4(ii), 3) = ASC(bs4(ii2), 3) _
                                   AND ASC(as4(ii), 4) = ASC(bs4(ii2), 4) OR _
                                   ASC(as4(ii), 2) = ASC(bs4(ii2), 2) AND ASC(as4(ii), 3) = ASC(bs4(ii2), 3) AND ASC(as4(ii), 4) = ASC(bs4(ii2), 4) _
                                   AND ASC(as4(ii), 5) = ASC(bs4(ii2), 5) OR _
                                   ASC(as4(ii), 1) = ASC(bs4(ii2), 1) AND ASC(as4(ii), 3) = ASC(bs4(ii2), 3) AND ASC(as4(ii), 4) = ASC(bs4(ii2), 4) _
                                   AND ASC(as4(ii), 5) = ASC(bs4(ii2), 5) OR _
                                   ASC(as4(ii), 1) = ASC(bs4(ii2), 1) AND ASC(as4(ii), 2) = ASC(bs4(ii2), 2) AND ASC(as4(ii), 4) = ASC(bs4(ii2), 4) _
                                   AND ASC(as4(ii), 5) = ASC(bs4(ii2), 5) OR _
                                   ASC(as4(ii), 1) = ASC(bs4(ii2), 1) AND ASC(as4(ii), 2) = ASC(bs4(ii2), 2) AND ASC(as4(ii), 3) = ASC(bs4(ii2), 3) _
                                   AND ASC(as4(ii), 5) = ASC(bs4(ii2), 5) THEN
                                      IF LEFT$(as4(ii), 5) = LEFT$(bs4(ii2), 5) THEN bs4(ii2) = MID$(bs4(ii2), 6)
                                      sTemp = SPACE$(60)
                                      MID$(sTemp, 1)  = MID$(as4(ii), 21, 5)
                                      MID$(sTemp, 7)  = MID$(as4(ii), 16, 5)
                                      MID$(sTemp, 13) = MID$(as4(ii), 11, 5)
                                      MID$(sTemp, 19) = MID$(as4(ii), 06, 5)
                                      MID$(sTemp, 25) = MID$(as4(ii), 01, 5)
                                      MID$(sTemp, 31) = MID$(bs4(ii2), 01, 5)
                                      MID$(sTemp, 37) = MID$(bs4(ii2), 06, 5)
                                      MID$(sTemp, 43) = MID$(bs4(ii2), 11, 5)
                                      MID$(sTemp, 49) = MID$(bs4(ii2), 16, 5)
                                      MID$(sTemp, 55) = MID$(bs4(ii2), 21, 5)
                                      INCR ii3
                                      IF ii3 < 8 THEN ? "Note: Only up to eight sequences will be shown of possibly 100's" & $CRLF & $CRLF & _
                                       RTRIM$(sTemp)     'there can be hundreds, so ii3 limits it to 8 results
                                END IF
                             NEXT
                          NEXT
                      
                      END FUNCTION

                      Comment


                        #31
                        Annnd..., here is the 6-letter/10-word max sequence version. Runs almost identically to the 5-letter version. Code differences are mainly formatting changes, and a couple array dimensions.

                        Code:
                        #COMPILE EXE
                        #DIM ALL
                        
                        UNION sixMax
                           cLine AS STRING * 4
                           cLong AS LONG
                        END UNION
                        
                        %NUMBERofWORDS = 11492
                        %LASTaRRAYsIZE = 3000            'if there is a GPF, try making this equate larger
                        %LASTaRRAYsIZE2= 12000           'if there is a GPF, try making this equate larger
                        
                        FUNCTION PBMAIN () AS LONG
                          LOCAL lineo AS STRING, ii, ii2, ii3, ii4, index, index2, index3, index4 AS LONG
                          LOCAL index5, index6, index7, index8, endLoop AS LONG
                          LOCAL compressLineo AS sixMax, inWord, outWord, sTemp AS STRING
                          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(%LASTaRRAYsIZE) AS LONG, a4(%LASTaRRAYsIZE2) AS LONG
                          DIM b1(100) AS LONG, b2(1000) AS LONG, b3(%LASTaRRAYsIZE) AS LONG, b4(%LASTaRRAYsIZE2) AS LONG
                          DIM as1(100) AS STRING, as2(1000) AS STRING, as3(%LASTaRRAYsIZE) AS STRING, as4(%LASTaRRAYsIZE2) AS STRING
                          DIM bs1(100) AS STRING, bs2(1000) AS STRING, bs3(%LASTaRRAYsIZE) AS STRING, bs4(%LASTaRRAYsIZE2) 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 26000
                               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
                        '          ii2 = ii
                               END IF
                            NEXT
                         '  ? "Ready to go..."
                            '-----------------------------------------------------------
                            '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
                        
                        '   inWord  = UCASE$("creepy")
                        '   outWord = UCASE$("shocks")
                            inWord  = UCASE$("voting")
                            outWord = UCASE$("server")
                            index = 0
                            FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with inWord, test it for any 1-letter-different matches
                               IF wordOrig6(ii3) = inWord THEN
                               FOR ii2 = 1 TO 6
                                  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) & inWord
                                           INCR index
                                        END IF
                                     END IF
                                  NEXT
                               NEXT
                               END IF
                            NEXT
                        
                           index2 = 0
                            FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with outWord, test it for any 1-letter-different matches
                               IF wordOrig6(ii3) = outWord THEN
                               FOR ii2 = 1 TO 6
                                  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) & outWord
                                           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 6
                                  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 6
                                  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(), "  ")
                        
                            FOR ii = 1 TO 1000          'slow logic here just for demo purposes. If 4 of 5 letters are equal, just 1 change completes.
                                                        'redo (someday) for speed using previous test for 1-letter differences as done above.
                               IF ASC(as2(ii)) < 65 THEN EXIT FOR
                               FOR ii2 = 1 TO 1000
                                  IF ASC(bs2(ii2)) < 65 THEN EXIT FOR
                                  IF ASC(as2(ii), 1) = ASC(bs2(ii2), 1) AND ASC(as2(ii), 2) = ASC(bs2(ii2), 2) AND ASC(as2(ii), 3) = ASC(bs2(ii2), 3) _
                                     AND ASC(as2(ii), 4) = ASC(bs2(ii2), 4) AND ASC(as2(ii), 5) = ASC(bs2(ii2), 5) OR _
                                     ASC(as2(ii), 2) = ASC(bs2(ii2), 2) AND ASC(as2(ii), 3) = ASC(bs2(ii2), 3) AND ASC(as2(ii), 4) = ASC(bs2(ii2), 4) _
                                     AND ASC(as2(ii), 5) = ASC(bs2(ii2), 5) AND ASC(as2(ii), 6) = ASC(bs2(ii2), 6) OR _
                                     ASC(as2(ii), 1) = ASC(bs2(ii2), 1) AND ASC(as2(ii), 3) = ASC(bs2(ii2), 3) AND ASC(as2(ii), 4) = ASC(bs2(ii2), 4) _
                                     AND ASC(as2(ii), 5) = ASC(bs2(ii2), 5) AND ASC(as2(ii), 6) = ASC(bs2(ii2), 6) OR _
                                     ASC(as2(ii), 1) = ASC(bs2(ii2), 1) AND ASC(as2(ii), 2) = ASC(bs2(ii2), 2) AND ASC(as2(ii), 4) = ASC(bs2(ii2), 4) _
                                     AND ASC(as2(ii), 5) = ASC(bs2(ii2), 5) AND ASC(as2(ii), 6) = ASC(bs2(ii2), 6)  OR _
                                     ASC(as2(ii), 1) = ASC(bs2(ii2), 1) AND ASC(as2(ii), 2) = ASC(bs2(ii2), 2) AND ASC(as2(ii), 3) = ASC(bs2(ii2), 3) _
                                     AND ASC(as2(ii), 5) = ASC(bs2(ii2), 5) AND ASC(as2(ii), 6) = ASC(bs2(ii2), 6) THEN
                                        IF LEFT$(as2(ii), 6) = LEFT$(bs2(ii2), 6) THEN bs2(ii2) = MID$(bs2(ii2), 7)
                                        sTemp = SPACE$(42)
                                        MID$(sTemp, 1)  = MID$(as2(ii), 13, 6)
                                        MID$(sTemp, 08) = MID$(as2(ii), 07, 6)
                                        MID$(sTemp, 15) = MID$(as2(ii), 01, 6)
                                        MID$(sTemp, 22) = MID$(bs2(ii2), 01, 6)
                                        MID$(sTemp, 29) = MID$(bs2(ii2), 07, 6)
                                        MID$(sTemp, 36) = MID$(bs2(ii2), 13, 6)
                                        ? RTRIM$(sTemp)
                                  END IF
                               NEXT
                            NEXT
                            '-----------------------------------------------------------
                            '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 6
                                  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 6
                                  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 %LASTaRRAYsIZE - 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(%LASTaRRAYsIZE - 1) <> a3(%LASTaRRAYsIZE) THEN 'handle last element
                               a3(ii2) = a3(%LASTaRRAYsIZE)
                               as3(ii2) = as3(%LASTaRRAYsIZE)
                               INCR ii2
                            END IF
                            FOR ii = ii2 TO %LASTaRRAYsIZE
                               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 %LASTaRRAYsIZE - 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(%LASTaRRAYsIZE - 1) <> b3(%LASTaRRAYsIZE) THEN 'handle last element (1000)
                               b3(ii2) = b3(%LASTaRRAYsIZE)
                               bs3(ii2) = bs3(%LASTaRRAYsIZE)
                               INCR ii2
                            END IF
                            FOR ii = ii2 TO %LASTaRRAYsIZE
                               b3(ii) = 0
                               bs3(ii) = ""
                            NEXT
                             ? JOIN$(as3(), "  ")
                             ? JOIN$(bs3(), "  ")
                        
                            FOR ii = 0 TO %LASTaRRAYsIZE - 1   'slow logic here just for demo purposes. If 4 of 5 letters are equal, just 1 change completes.
                               IF ASC(as3(ii)) < 65 THEN EXIT FOR
                               FOR ii2 = 0 TO %LASTaRRAYsIZE - 1
                                  IF ASC(bs3(ii2)) < 65 THEN EXIT FOR
                                  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) AND ASC(as3(ii), 5) = ASC(bs3(ii2), 5) OR _
                                     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) _
                                     AND ASC(as3(ii), 5) = ASC(bs3(ii2), 5) AND ASC(as3(ii), 6) = ASC(bs3(ii2), 6) OR _
                                     ASC(as3(ii), 1) = ASC(bs3(ii2), 1) AND ASC(as3(ii), 3) = ASC(bs3(ii2), 3) AND ASC(as3(ii), 4) = ASC(bs3(ii2), 4) _
                                     AND ASC(as3(ii), 5) = ASC(bs3(ii2), 5) AND ASC(as3(ii), 6) = ASC(bs3(ii2), 6) OR _
                                     ASC(as3(ii), 1) = ASC(bs3(ii2), 1) AND ASC(as3(ii), 2) = ASC(bs3(ii2), 2) AND ASC(as3(ii), 4) = ASC(bs3(ii2), 4) _
                                     AND ASC(as3(ii), 5) = ASC(bs3(ii2), 5) AND ASC(as3(ii), 6) = ASC(bs3(ii2), 6)  OR _
                                     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), 5) = ASC(bs3(ii2), 5) AND ASC(as3(ii), 6) = ASC(bs3(ii2), 6) THEN
                                        IF LEFT$(as3(ii), 6) = LEFT$(bs3(ii2), 6) THEN bs3(ii2) = MID$(bs3(ii2), 7)
                                        sTemp = SPACE$(56)
                                        MID$(sTemp, 1)  = MID$(as3(ii), 19, 6)
                                        MID$(sTemp, 08) = MID$(as3(ii), 13, 6)
                                        MID$(sTemp, 15) = MID$(as3(ii), 07, 6)
                                        MID$(sTemp, 22) = MID$(as3(ii), 01, 6)
                                        MID$(sTemp, 29) = MID$(bs3(ii2), 01, 6)
                                        MID$(sTemp, 36) = MID$(bs3(ii2), 07, 6)
                                        MID$(sTemp, 43) = MID$(bs3(ii2), 13, 6)
                                        MID$(sTemp, 50) = MID$(bs3(ii2), 19, 6)
                                        ? RTRIM$(sTemp)
                                  END IF
                               NEXT
                            NEXT
                        
                            '-----------------------------------------------------------
                            'Now get fourth arrays of words that are 1 letter different from the last found arrays...
                            '-----------------------------------------------------------
                            FOR ii4 = 0 TO index5 - 1
                            FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with a2(), test it for any 1-letter-different matches
                               IF word6(ii3) = a3(ii4) THEN
                               FOR ii2 = 1 TO 6
                                  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
                                           a4(index7) = word6(ii)
                                           as4(index7) = wordOrig6(ii) & as3(ii4)
                                           INCR index7
                                        END IF
                                     END IF
                                  NEXT
                               NEXT
                               END IF
                            NEXT
                            NEXT
                        
                            FOR ii4 = 0 TO index6 - 1
                            FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with b2(), test it for any 1-letter-different matches
                               IF word6(ii3) = b3(ii4) THEN
                               FOR ii2 = 1 TO 6
                                  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
                                           b4(index8) = word6(ii)
                                           bs4(index8) = wordOrig6(ii) & bs3(ii4)
                                           INCR index8
                                        END IF
                                     END IF
                                  NEXT
                               NEXT
                               END IF
                            NEXT
                            NEXT
                        
                        'eliminate duplicates in a4() and as4() < this is the human readable version of a4()
                            ARRAY SORT a4(), TAGARRAY as4()
                            ii2 = 0
                            FOR ii = 0 TO %LASTaRRAYsIZE2 - 1
                               IF a4(ii) = 0 THEN ITERATE FOR
                               IF a4(ii) = a4(ii + 1) THEN
                                  ITERATE FOR
                               ELSE
                                  a4(ii2) = a4(ii)
                                  as4(ii2) = as4(ii)
                                  INCR ii2
                               END IF
                            NEXT
                            IF a4(%LASTaRRAYsIZE2 - 1) <> a4(%LASTaRRAYsIZE2) THEN 'handle last element
                               a4(ii2) = a4(%LASTaRRAYsIZE2)
                               as4(ii2) = as4(%LASTaRRAYsIZE2)
                               INCR ii2
                            END IF
                            FOR ii = ii2 TO %LASTaRRAYsIZE2
                               a4(ii) = 0
                               as4(ii) = ""
                            NEXT
                        'eliminate duplicates in b4() and bs4() < this is the human readable version of b4()
                            ARRAY SORT b4(), TAGARRAY bs4()
                            ii2 = 0
                            FOR ii = 0 TO %LASTaRRAYsIZE2 - 1
                               IF b4(ii) = 0 THEN ITERATE FOR
                               IF b4(ii) = b4(ii + 1) THEN
                                  ITERATE FOR
                               ELSE
                                  b4(ii2) = b4(ii)
                                  bs4(ii2) = bs4(ii)
                                  INCR ii2
                               END IF
                            NEXT
                            IF b4(%LASTaRRAYsIZE2 - 1) <> b4(%LASTaRRAYsIZE2) THEN 'handle last element (1000)
                               b4(ii2) = b4(%LASTaRRAYsIZE2)
                               bs4(ii2) = bs4(%LASTaRRAYsIZE2)
                               INCR ii2
                            END IF
                            FOR ii = ii2 TO %LASTaRRAYsIZE2
                               b4(ii) = 0
                               bs4(ii) = ""
                            NEXT
                        '   ? JOIN$(as4(), "  ")
                        '   ? JOIN$(bs4(), "  ")
                            ii3 = 0
                            FOR ii = 0 TO %LASTaRRAYsIZE2 - 1   'slow logic here just for demo purposes. If 4 of 5 letters are equal, just 1 change completes.
                               IF ASC(as4(ii)) < 65 THEN EXIT FOR
                               FOR ii2 = 0 TO %LASTaRRAYsIZE2 - 1
                                  IF ASC(bs4(ii2)) < 65 THEN EXIT FOR
                                  IF ASC(as4(ii), 1) = ASC(bs4(ii2), 1) AND ASC(as4(ii), 2) = ASC(bs4(ii2), 2) AND ASC(as4(ii), 3) = ASC(bs4(ii2), 3) _
                                     AND ASC(as4(ii), 4) = ASC(bs4(ii2), 4) AND ASC(as4(ii), 5) = ASC(bs4(ii2), 5) OR _
                                     ASC(as4(ii), 2) = ASC(bs4(ii2), 2) AND ASC(as4(ii), 3) = ASC(bs4(ii2), 3) AND ASC(as4(ii), 4) = ASC(bs4(ii2), 4) _
                                     AND ASC(as4(ii), 5) = ASC(bs4(ii2), 5) AND ASC(as4(ii), 6) = ASC(bs4(ii2), 6) OR _
                                     ASC(as4(ii), 1) = ASC(bs4(ii2), 1) AND ASC(as4(ii), 3) = ASC(bs4(ii2), 3) AND ASC(as4(ii), 4) = ASC(bs4(ii2), 4) _
                                     AND ASC(as4(ii), 5) = ASC(bs4(ii2), 5) AND ASC(as4(ii), 6) = ASC(bs4(ii2), 6) OR _
                                     ASC(as4(ii), 1) = ASC(bs4(ii2), 1) AND ASC(as4(ii), 2) = ASC(bs4(ii2), 2) AND ASC(as4(ii), 4) = ASC(bs4(ii2), 4) _
                                     AND ASC(as4(ii), 5) = ASC(bs4(ii2), 5) AND ASC(as4(ii), 6) = ASC(bs4(ii2), 6)  OR _
                                     ASC(as4(ii), 1) = ASC(bs4(ii2), 1) AND ASC(as4(ii), 2) = ASC(bs4(ii2), 2) AND ASC(as4(ii), 3) = ASC(bs4(ii2), 3) _
                                     AND ASC(as4(ii), 5) = ASC(bs4(ii2), 5) AND ASC(as4(ii), 6) = ASC(bs4(ii2), 6) THEN
                                        IF LEFT$(as4(ii), 6) = LEFT$(bs4(ii2), 6) THEN bs4(ii2) = MID$(bs4(ii2), 7)
                                        sTemp = SPACE$(70)
                                        MID$(sTemp, 1)  = MID$(as4(ii), 25, 6)
                                        MID$(sTemp, 8)  = MID$(as4(ii), 19, 6)
                                        MID$(sTemp, 15) = MID$(as4(ii), 13, 6)
                                        MID$(sTemp, 22) = MID$(as4(ii), 07, 6)
                                        MID$(sTemp, 29) = MID$(as4(ii), 01, 6)
                                        MID$(sTemp, 36) = MID$(bs4(ii2), 01, 6)
                                        MID$(sTemp, 43) = MID$(bs4(ii2), 07, 6)
                                        MID$(sTemp, 50) = MID$(bs4(ii2), 13, 6)
                                        MID$(sTemp, 57) = MID$(bs4(ii2), 19, 6)
                                        MID$(sTemp, 64) = MID$(bs4(ii2), 25, 6)
                                        INCR ii3
                                        IF ii3 < 8 THEN ? "Note: Only up to eight sequences will be shown of possibly 100's" & $CRLF & $CRLF & _
                                         RTRIM$(sTemp)     'there can be hundreds, so ii3 limits it to 8 results
                                  END IF
                               NEXT
                            NEXT
                        
                        END FUNCTION

                        Comment


                          #32
                          Originally posted by John Gleason View Post
                          I couldn't quit messing with it,
                          Gets addictive, don't it? {grin}

                          I rebuilt the word list in word length order:
                          2, AB
                          2, AC
                          2, AD
                          2, AH
                          ...
                          22, ELECTROENCEPHALOGRAPHY
                          23, DISESTABLISMENTARIANISM
                          23, ELECTROENCEPHALOGRAPHIC
                          25, ANTIDISESTABLISHMENTARIAN
                          28, ANTIDISESTABLISHMENTARIANISM
                          -1, End Words

                          109,582 elements 109,581 Data Words

                          140 2 letter words
                          853 3 letter words
                          3,130 4 letter words
                          6,919 5 letter words
                          11,492 6 letter words
                          16,882 7 letter words
                          19,461 8 letter words
                          16,693 9 letter words
                          11,882 10 letter words
                          8,374 11 letter words
                          5,812 12 letter words
                          3,676 13 letter words
                          2,102 14 letter words
                          1,159 15 letter words
                          583 16 letter words
                          229 17 letter words
                          107 18 letter words
                          39 19 letter words
                          29 20 letter words
                          11 21 letter words
                          4 22 letter words
                          2 23 letter words
                          0 24 letter words
                          1 25 letter words
                          0 26 letter words
                          0 27 letter words
                          1 28 letter words
                          0 29 letter words
                          0 30 letter words
                          From the summary it looks like the range of possible chains range from 3 to 10 letters. Just a guess, though.

                          And here's a zip of the whole file for any who are interested:



                          ============================================================
                          "Intellectuals solve problems;
                          geniuses prevent them."
                          Albert Einstein
                          ============================================================
                          It's a pretty day. I hope you enjoy it.

                          Gösta

                          JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                          LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                          Comment


                            #33
                            OK, now are you going to sort them by alphabet?

                            I had sorted them by length, but only up to ten letter words and kept everything in a separate file pending further decisions on my part.

                            Yes this has become a bit of a fixation.

                            I am wondering though, isn't a program for doing this making the original puzzle a non puzzle?

                            Rod
                            Rod
                            In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

                            Comment


                              #34
                              Originally posted by Rodney Hicks View Post
                              OK, now are you going to sort them by alphabet?
                              Words.txt is sorted by alpha (beginning at the 7th char). Data_Words.txt is sorted by Size then alpha.

                              Yes this has become a bit of a fixation.
                              Tell me about it.


                              I am wondering though, isn't a program for doing this making the original puzzle a non puzzle?

                              Rod
                              Sure. But it's the challenge of doing it. I used to do the Jumble Puzzle every day in the newspaper. However after writing a routine to solve them (how I came up with the Ascii hash), I lost interest in it. {sigh}

                              As far as the Word Progression goes, I see a use in a grade school application if variables can be used as inputs (ie Start_Word$, Done_Word$), teachers could use it for fun spelling exercises (for example). Say 3 word sequences for 1st or 2nd grade an so on.

                              I wrote a Word Search routine (on a TRS 80) that used weekly spelling lists (for my wife, who was teaching 4th at the time). It printed a puzzle and an answer sheet. Teachers did it once for each grade level, then made copies they used year after year. It ended up being used throughout the district in several lower grades (2nd through 5th I know of). Might still be used, I don't know (the copies, not the program). They were quite popular with the kids (a "fun" homework assignment).

                              ==================================
                              "If you are going through hell,
                              keep going."
                              Sir Winston Churchill (1874-1965)
                              ==================================
                              It's a pretty day. I hope you enjoy it.

                              Gösta

                              JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                              LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                              Comment


                                #35
                                One of the fun things about using the program is trying to get interesting sequences, along the line of THINK-BRAIN. e.g. I thought this one was kinda funny:

                                SWIMS-CRAMP. It produced SWIMS SLIMS SLAMS CLAMS CLAMP CRAMP.

                                Comment


                                  #36
                                  Also, you could swim with crabs AND clams while cramping up:

                                  SWIMS SLIMS SLAMS CLAMS CRAMS CRABS CRAMS CRAMP

                                  Comment


                                    #37
                                    Quote:
                                    Originally Posted by Rodney Hicks
                                    OK, now are you going to sort them by alphabet?

                                    I answered:
                                    Words.txt is sorted by alpha (beginning at the 7th char). Data_Words.txt is sorted by Size then alpha.

                                    That was a misspoken. Words.txt is sorted by Ascii value then alpha. Easy enough to build another file though in alpha order.

                                    ================================
                                    Anger is never without a reason
                                    but seldom a good one.
                                    Ben Franklin
                                    ================================
                                    It's a pretty day. I hope you enjoy it.

                                    Gösta

                                    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                    Comment


                                      #38
                                      John,

                                      I incorporated your super algor into my GUI interface. The only problem is the algo only solves once per run. I've looked and can see no reason why. You routine uses all Locals and none conflict with mine. Ditto Globals.

                                      '
                                      Code:
                                      #Compile Exe
                                      #Dim All
                                      '------------------------------------------------------------------------------
                                      '   ** Includes **
                                      '------------------------------------------------------------------------------
                                      #Include "WIN32API.INC"
                                      '#Include "C:\Power Basic\Includes\clipboard.inc"
                                      '#Include "C:\Power Basic\Includes\Common_Constants.inc"
                                      '#Include "c:\Power Basic\Includes\Fonts.inc"
                                      '#Include "c:\Power Basic\Includes\Colors.inc"
                                      ' #Include "C:\Power Basic\Includes\Common_Macros.inc" 
                                      '#Include "C:\Power Basic\Includes\process_memoryinfo.inc"  
                                      '#Include "C:\Power Basic\Includes\Common_Subs_Funcs.inc"
                                      '#Resource "C:\Power Basic\Icons\Icons.pbr"
                                      '#Include "C:\Power Basic\Includes\File_Exist.inc"
                                            'In Common_Locals
                                      '''#Include "C:\Power Basic\Includes\Variables_Common_to_All_Programs.inc"
                                       
                                      '------------------------------------------------------------------------------
                                      '------------------------------------------------------------------------------
                                      '   ** Constants **
                                      '------------------------------------------------------------------------------
                                      'John's stuff
                                      Union sixMax
                                         cLine As String * 4
                                         cLong As Long
                                      End Union
                                      %NUMBERofWORDS = 11492
                                      %LASTaRRAYsIZE = 3000            'if there is a GPF, try making this equate larger
                                      %LASTaRRAYsIZE2= 12000           'if there is a GPF, try making this equate larger
                                      'End John's stuff
                                       
                                      %Box_Height = 20   
                                      %Char_Width = 5    
                                      
                                      %Btn_01     = 1002 
                                      %Word_Start = 1003 
                                      %Word_Done  = 1004 
                                      %Working_Label  = 1005 
                                      '------------------------------------------------------------------------------
                                      Union sixMax
                                         cLine As String * 4
                                         cLong As Long
                                      End Union
                                       Global g_Words$()
                                      ' Global g_Words$()
                                      '------------------------------------------------------------------------------
                                      '------------------------------------------------------------------------------
                                      '   ** Macros **
                                      '------------------------------------------------------------------------------
                                      Macro Common_Locals
                                        Local Reps&
                                        Local Number_of_Words&, Words_In_File&, Word_Len&
                                        Local First_Word$, Last_Word$, total_Words_in_File$
                                        Local W$, w1$, w2$, w3$
                                          Local WL$(), Word_List$
                                        Local Used_Words$(), Sequences$()
                                        Local Ttls&(), tb_len&
                                        
                                      ' Variables_Common_to_All_Programs
                                        Local a&, a1&, a2&, a3&, a4&, a5&, Ans&, askii&, Askii_Last&
                                       
                                        Local b&, Box_Height&, Box_Width&, Btn_Width&, Btn_Height&
                                          Local Beep_Freq As Dword, Beep_Duration As Dword
                                          Local Beep_Ctr&, Beep_b&
                                       
                                        Local Caption$, chk$ 
                                           Local col&, col1&, col2&, col3&, col4&, col5&
                                           Local ctr&, ctr1&, ctr2&, ctr3&, ctr4&, ctr5&
                                        
                                        Local End_Marked&, Start_Marked&
                                         Local er$ 'used for error msgs
                                        Local Flag&, Flag1&, Flag2&, Flag3&, Flag4&, Flag5&  
                                        Local Fle$, Fle1$, Fle2$, Fle3$, Fle4$, Fle5$ 
                                          Local Flen&, Flen1&, Flen2&, Flen3&, Flen4&, Flen5&
                                          Local Fn$, Fn1$, Fn2$, Fn3$, Fn4$, Fn5$ 
                                          Local fnum&, fnum1&, fnum2&, fnum3&, fnum4&, fnum5&
                                        
                                        Global g_Timer#
                                        
                                        Local hght&, hFont&, Highlighted_Word_Flag&  
                                        Local i&, i1&, i2&, i3&, i4&, i5&
                                          Local Id&, Id1&, Id2&, Id3&, Id4&, Id5&
                                        Local l$, l1$, l2$, l3$, l4$, l5$
                                          Local lbl$, Last_i&, lRslt&
                                          Local ln&, ln1&, ln2&, ln6&, ln4&, ln5&
                                        Local m$, m1$, m2$, m3$, m4$, m5$
                                        Local n$, n1$, n2$, n3$, n4$, n5$ 
                                          Local nm$, nm1$, nm2$, nm3$, nm4$, nm5$
                                          Local NumLines&
                                        
                                        Local Row&, Row1&, Row2&, Row3&, Row4&, Row5&
                                          Local rn&, rn1&
                                        
                                        Local s$, s1$, s2$, s3$, s4$, s5$ 
                                        Local Sln&, sp$, Stile&, stp&
                                        
                                        Local t$, t1$, t2$, t3$, t4$, t5$
                                         Local Tb_Height&, Tgl$
                                         Local temp$
                                         Local tmp$(), tmp1$(), tmp1$(), tmp2$(), tmp3$(), tmp4$(), tmp5$()
                                        
                                        Local u$, url$
                                        
                                        Local v&, vlu&
                                        
                                        Local Wdth&, Wait&       
                                        
                                        Local x&, x1&, x2&, x3&, x4&, x5&
                                        Local y&, y1&, y2&, y3&, y4&, y5&
                                        
                                        
                                        %Top = %MB_TASKMODAL 'keep for older msgbox msgs  
                                      'Common RGB Colors from Win32Api.Inc 
                                      '  %Black   = &H000000???
                                      '  %Blue    = &HFF0000???
                                      '  %Green   = &H00FF00???
                                      '  %Cyan    = &HFFFF00???
                                      '  %Red     = &H0000FF???
                                      '  %Magenta = &HFF00FF???
                                      '  %Yellow  = &H00FFFF???
                                      '  %White   = &HFFFFFF???
                                      '  %Gray    = &H808080???
                                      '  %LtGray  = &HC0C0C0???
                                        %Purple = &hFF5588
                                        %BabyBlue = 167 + (241 * 256) + (252 * 256 * 256) 
                                        %Pink     = 255 + (132 * 256) + (132 * 256 * 256)
                                        %Cream    = 252 + (241 * 256) + (167 * 256 * 256) 
                                        %BiliousYG = %Cream + 1000 ' Bilious Yellow Green 
                                        %MintGreen = &HD0FFD0
                                        %Win_Gray = &hEAE9E8  
                                        
                                      End Macro
                                      '
                                      Macro Label_Set_Main 
                                          Control Set Color hDlg, %Working_Label, -1, %Win_Gray 
                                          lbl$ = "Solving Algorithm " & $CrLf & _
                                                 "   courtesy of:   " & $CrLf & _
                                                 "   John Gleason   " & $CrLf & _
                                                 "       and        " & $CrLf & _
                                                 " PowerBASIC Forums"  
                                          Control Set Text hDlg, %Working_Label, lbl$
                                      End Macro
                                      '
                                      Macro Label_Set_Working 
                                          Control Set Color hDlg, %Working_Label, -1, %Yellow
                                          lbl$ = " Working  " & $CrLf & _
                                                 "   on   " & $CrLf & _
                                                 "lgorithm" & $CrLf & _
                                                 "     for        " & $CrLf & _
                                                 " PowerBASIC Forums"  
                                          Control Set Text hDlg, %Working_Label, lbl$
                                      End Macro
                                      '
                                      Macro Label_Set_No_Answer
                                          Control Set Color hDlg, %Working_Label, -1, %Pink
                                          lbl$ =  $CrLf & "No Chains found!" & _
                                                  $CrLf & $CrLf & _
                                                  "Solved in" & $CrLf & _
                                                  Using$(".## Seconds ", Timer - g_Timer)
                                          Control Set Text hDlg, %Working_Label, lbl$
                                      End Macro
                                      '
                                      Macro Label_Set_Done
                                          Control Set Color hDlg, %Working_Label, -1, %BabyBlue
                                          lbl$ =  Using$("# Answer Chains", UBound(Sequences$)) & $CrLf & _
                                                  "are in the Clipboard" & $CrLf &  _
                                                  $CrLf & _
                                                  "Solved in" & $CrLf & _
                                                  Using$(".## Seconds ", Timer - g_Timer)
                                          Control Set Text hDlg, %Working_Label, lbl$
                                      End Macro
                                      '
                                      Macro m_Input_Open 
                                       fnum = FreeFile
                                       Open fn$ For Input As #fnum
                                          m$ = fn$ 'for err msg
                                          m1$ = "m_Input_Open"
                                          m_Err_Msg
                                      End Macro
                                      '
                                      Macro m_Output_Open  
                                        fnum = FreeFile
                                        Open fn$ For Output As #fnum
                                          m$ = fn$ 'for err msg
                                          m1$ = "m_Output_Open"
                                          m_Err_Msg
                                      End Macro
                                      '
                                      Macro pf = Print #fnum, 
                                      '
                                      Macro pf1 = Print #fnum1, 
                                      '
                                      Macro pf2 = Print #fnum2, 
                                      ' 
                                      Macro m_Binary_Open
                                         fnum = FreeFile
                                          Open fn$ For Binary As fnum
                                           flen = Lof(fnum)   
                                           
                                         Fle$ = Space$(flen)'create a space to put the file
                                         Get fnum,,fle$  'put the file in the space
                                         Close fnum 
                                         m$ = fn$ 
                                         m1$ = "m_Binary_Open"
                                         m_Err_Msg 'Msgbox if an error
                                      End Macro
                                      '
                                      Macro m_Err_Msg 
                                       If Err Then 
                                          Stile = %MB_SYSTEMMODAL Or _          
                                                  %MB_ICONERROR Or _
                                                  %MB_ICONWARNING  
                                                  
                                         ? m$ & $CrLf & $CrLf & _           
                                           m1$ & $CrLf & $CrLf & _           
                                           Using$("# ", Err) & Error$(Err),_
                                           Stile, _
                                           " In " & FuncName$ 
                                       End If 
                                       Reset m$, m1$ 
                                      End Macro 
                                      '                  
                                      Macro mb   
                                        MsgBox m$ & $CrLf & $CrLf & m1$, _
                                              %MB_TASKMODAL, _
                                              " In " & FuncName$ 
                                        Reset m$, m1$
                                      End Macro      
                                      '
                                      Macro mb_Alert
                                        MsgBox m$ & $CrLf & $CrLf & m1$, _
                                              %MB_TASKMODAL Or %MB_ICONWARNING, _
                                              " In " & FuncName$ 
                                        Reset m$, m1$
                                      End Macro                               
                                      '
                                      '------------------------------------------------------------------------------
                                      '<== Start of Clipboard as an Include ==>
                                      'Clipboard stuff gotten from Poffs but I forget from whom
                                      '
                                      'Note t$ must be initialized - Local t$
                                      Function Clipboard_Set_Text Alias "Clipboard_Set_Text" _
                                                    (ByVal sText As String) Export As Long
                                        Local hData As Long, hGlob As Long
                                      ' ** Create a global memory object and copy the data into it
                                        hData = GlobalAlloc(%GMEM_MOVEABLE Or %GMEM_DDESHARE, Len(sText) + 1)
                                        hGlob = GlobalLock(hData)
                                        Poke$ hGlob, sText + Chr$(0)
                                        GlobalUnlock hData
                                      ' ** Open the clipboard
                                        If IsFalse(OpenClipboard(%Null)) Then
                                          GlobalFree hData
                                          Exit Function
                                        End If
                                      ' ** Paste the data into the clipboard
                                        EmptyClipboard  'WinAPI
                                        Function = SetClipboardData(%CF_TEXT, hData) 'WinAPI
                                        CloseClipboard  'WinAPI
                                      End Function
                                      Function Clipboard_Get_Text Alias "Clipboard_Get_Text"() Export As String
                                          Local zPtr As Asciiz Ptr
                                          OpenClipboard 0 'WinAPI
                                          zPtr = GetClipboardData(%CF_TEXT)
                                          If zPtr <> 0 Then Function = @zPtr
                                          CloseClipboard   'WinAPI
                                      End Function
                                      '                   
                                      '
                                      Macro Get_Clipboard =  t$ = Clipboard_Get_Text 'put cb in tb at program start 
                                      '
                                      Macro Set_Clipboard = Clipboard_Set_Text(t$)
                                      '
                                      '<== End of Clipboard as an Include ==>
                                      '
                                      Macro W_Check_Words_Validity   
                                        Control Get Text hDlg, %Word_Start To First_Word$
                                          First_Word$ =UCase$(First_Word$)
                                        Control Get Text hDlg, %Word_Done  To Last_Word$
                                          Last_Word$ = UCase$(Last_Word$)
                                        
                                           'data tests
                                        If Len(First_Word$) <> Len(Last_Word$) Then
                                           m$ = "Words must be the Same Length": mb_Alert: Exit Sub 
                                          ElseIf  Len(First_Word$) < 2 Then
                                           m$ = "Words must be longer than 1 letter": mb_Alert: Exit Sub 
                                          ElseIf  Len(First_Word$) > 10 Then
                                           m$ = "Words must be 10 letters or less long": mb_Alert: Exit Sub 
                                          ElseIf  First_Word$ = Last_Word$ Then
                                           m$ = "Words must different": mb_Alert: Exit Sub 
                                          Else 
                                           'm$="Okay": mb
                                        End If                       
                                        
                                        Word_Len = Len(First_Word$)                
                                        
                                        Call Data_Words_into_Array(Word_Len)
                                        
                                        'check to make sure words are in array
                                        Flag = 0
                                        For ctr = LBound(g_Words$) To UBound(g_Words$)
                                            If g_Words$(ctr) = First_Word$ Then 
                                              Flag = 1'found
                                              Exit For
                                            End If  
                                        Next ctr
                                        If Flag = 0 Then 
                                           m$ = First_Word$ & " is not an eligible word"
                                           mb_Alert
                                           Exit Sub 
                                        End If
                                        
                                        Flag = 0
                                        For ctr = LBound(g_Words$) To UBound(g_Words$)
                                            If g_Words$(ctr) = Last_Word$ Then
                                              Flag = 1'found
                                              Exit For
                                            End If  
                                        Next ctr
                                      '  m1$ = "test":m$ = Using$("#, #, ", ctr, UBound(g_Words$)): mb: Exit Sub
                                          If Flag = 0 Then
                                            m$ = Last_Word$ & " is not an eligible word"
                                            mb_Alert
                                            Exit Sub 
                                          End If
                                        Number_of_Words = UBound(g_Words)
                                      End Macro                   
                                      '
                                      
                                      '------------------------------------------------------------------------------
                                      '   ** Globals **
                                      '------------------------------------------------------------------------------
                                          Global hDlg  As Dword
                                      '------------------------------------------------------------------------------
                                      Sub John_Solver
                                        Common_Locals
                                          g_Timer = Timer
                                         Label_Set_Working 
                                         W_Check_Words_Validity  'returns Word_len & g_Words$()
                                                               '   First_Word$, Last_Word$
                                         Erase Sequences$ 'array to hold answers
                                        Local lineo As String, ii, ii2, ii3, ii4, index, index2, index3, index4 As Long
                                        Local index5, index6, index7, index8, endLoop As Long
                                        Local compressLineo As sixMax, inWord, outWord, sTemp As String
                                        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(%LASTaRRAYsIZE) As Long, a4(%LASTaRRAYsIZE2) As Long
                                        Dim b1(100) As Long, b2(1000) As Long, b3(%LASTaRRAYsIZE) As Long, b4(%LASTaRRAYsIZE2) As Long
                                        Dim as1(100) As String, as2(1000) As String, as3(%LASTaRRAYsIZE) As String, as4(%LASTaRRAYsIZE2) As String
                                        Dim bs1(100) As String, bs2(1000) As String, bs3(%LASTaRRAYsIZE) As String, bs4(%LASTaRRAYsIZE2) As String
                                          Open CurDir$ & "\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 26000
                                             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
                                      '          ii2 = ii
                                             End If
                                          Next
                                       '  ? "Ready to go..."
                                          '-----------------------------------------------------------
                                          '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
                                      '   inWord  = UCASE$("creepy")
                                      '   outWord = UCASE$("shocks")
                                      '    inWord  = UCase$("voting")
                                      '    outWord = UCase$("server")
                                          inWord  = First_Word$
                                          outWord = Last_Word$
                                      '    m$ = inWord:m1$ = OutWord:mb
                                          index = 0
                                          For ii3 = 0 To %NUMBERofWORDS                  'starting with inWord, test it for any 1-letter-different matches
                                             If wordOrig6(ii3) = inWord Then
                                             For ii2 = 1 To 6
                                                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) & inWord
                                                         Incr index
                                                      End If
                                                   End If
                                                Next
                                             Next
                                             End If
                                          Next
                                         index2 = 0
                                          For ii3 = 0 To %NUMBERofWORDS                  'starting with outWord, test it for any 1-letter-different matches
                                             If wordOrig6(ii3) = outWord Then
                                             For ii2 = 1 To 6
                                                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) & outWord
                                                         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 6
                                                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 6
                                                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(), "  ")
                                          For ii = 1 To 1000          'slow logic here just for demo purposes. If 4 of 5 letters are equal, just 1 change completes.
                                                                      'redo (someday) for speed using previous test for 1-letter differences as done above.
                                             If Asc(as2(ii)) < 65 Then Exit For
                                             For ii2 = 1 To 1000
                                                If Asc(bs2(ii2)) < 65 Then Exit For
                                                If Asc(as2(ii), 1) = Asc(bs2(ii2), 1) And Asc(as2(ii), 2) = Asc(bs2(ii2), 2) And Asc(as2(ii), 3) = Asc(bs2(ii2), 3) _
                                                   And Asc(as2(ii), 4) = Asc(bs2(ii2), 4) And Asc(as2(ii), 5) = Asc(bs2(ii2), 5) Or _
                                                   Asc(as2(ii), 2) = Asc(bs2(ii2), 2) And Asc(as2(ii), 3) = Asc(bs2(ii2), 3) And Asc(as2(ii), 4) = Asc(bs2(ii2), 4) _
                                                   And Asc(as2(ii), 5) = Asc(bs2(ii2), 5) And Asc(as2(ii), 6) = Asc(bs2(ii2), 6) Or _
                                                   Asc(as2(ii), 1) = Asc(bs2(ii2), 1) And Asc(as2(ii), 3) = Asc(bs2(ii2), 3) And Asc(as2(ii), 4) = Asc(bs2(ii2), 4) _
                                                   And Asc(as2(ii), 5) = Asc(bs2(ii2), 5) And Asc(as2(ii), 6) = Asc(bs2(ii2), 6) Or _
                                                   Asc(as2(ii), 1) = Asc(bs2(ii2), 1) And Asc(as2(ii), 2) = Asc(bs2(ii2), 2) And Asc(as2(ii), 4) = Asc(bs2(ii2), 4) _
                                                   And Asc(as2(ii), 5) = Asc(bs2(ii2), 5) And Asc(as2(ii), 6) = Asc(bs2(ii2), 6)  Or _
                                                   Asc(as2(ii), 1) = Asc(bs2(ii2), 1) And Asc(as2(ii), 2) = Asc(bs2(ii2), 2) And Asc(as2(ii), 3) = Asc(bs2(ii2), 3) _
                                                   And Asc(as2(ii), 5) = Asc(bs2(ii2), 5) And Asc(as2(ii), 6) = Asc(bs2(ii2), 6) Then
                                                      If Left$(as2(ii), 6) = Left$(bs2(ii2), 6) Then bs2(ii2) = Mid$(bs2(ii2), 7)
                                                      sTemp = Space$(42)
                                                      Mid$(sTemp, 1)  = Mid$(as2(ii), 13, 6)
                                                      Mid$(sTemp, 08) = Mid$(as2(ii), 07, 6)
                                                      Mid$(sTemp, 15) = Mid$(as2(ii), 01, 6)
                                                      Mid$(sTemp, 22) = Mid$(bs2(ii2), 01, 6)
                                                      Mid$(sTemp, 29) = Mid$(bs2(ii2), 07, 6)
                                                      Mid$(sTemp, 36) = Mid$(bs2(ii2), 13, 6)
                                      '                ? RTrim$(sTemp)
                                                End If
                                             Next
                                          Next
                                          '-----------------------------------------------------------
                                          '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 6
                                                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 6
                                                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 %LASTaRRAYsIZE - 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(%LASTaRRAYsIZE - 1) <> a3(%LASTaRRAYsIZE) Then 'handle last element
                                             a3(ii2) = a3(%LASTaRRAYsIZE)
                                             as3(ii2) = as3(%LASTaRRAYsIZE)
                                             Incr ii2
                                          End If
                                          For ii = ii2 To %LASTaRRAYsIZE
                                             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 %LASTaRRAYsIZE - 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(%LASTaRRAYsIZE - 1) <> b3(%LASTaRRAYsIZE) Then 'handle last element (1000)
                                             b3(ii2) = b3(%LASTaRRAYsIZE)
                                             bs3(ii2) = bs3(%LASTaRRAYsIZE)
                                             Incr ii2
                                          End If
                                          For ii = ii2 To %LASTaRRAYsIZE
                                             b3(ii) = 0
                                             bs3(ii) = ""
                                          Next
                                      '     ? Join$(as3(), "  ")
                                      '     ? Join$(bs3(), "  ")
                                          For ii = 0 To %LASTaRRAYsIZE - 1   'slow logic here just for demo purposes. If 4 of 5 letters are equal, just 1 change completes.
                                             If Asc(as3(ii)) < 65 Then Exit For
                                             For ii2 = 0 To %LASTaRRAYsIZE - 1
                                                If Asc(bs3(ii2)) < 65 Then Exit For
                                                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) And Asc(as3(ii), 5) = Asc(bs3(ii2), 5) Or _
                                                   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) _
                                                   And Asc(as3(ii), 5) = Asc(bs3(ii2), 5) And Asc(as3(ii), 6) = Asc(bs3(ii2), 6) Or _
                                                   Asc(as3(ii), 1) = Asc(bs3(ii2), 1) And Asc(as3(ii), 3) = Asc(bs3(ii2), 3) And Asc(as3(ii), 4) = Asc(bs3(ii2), 4) _
                                                   And Asc(as3(ii), 5) = Asc(bs3(ii2), 5) And Asc(as3(ii), 6) = Asc(bs3(ii2), 6) Or _
                                                   Asc(as3(ii), 1) = Asc(bs3(ii2), 1) And Asc(as3(ii), 2) = Asc(bs3(ii2), 2) And Asc(as3(ii), 4) = Asc(bs3(ii2), 4) _
                                                   And Asc(as3(ii), 5) = Asc(bs3(ii2), 5) And Asc(as3(ii), 6) = Asc(bs3(ii2), 6)  Or _
                                                   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), 5) = Asc(bs3(ii2), 5) And Asc(as3(ii), 6) = Asc(bs3(ii2), 6) Then
                                                      If Left$(as3(ii), 6) = Left$(bs3(ii2), 6) Then bs3(ii2) = Mid$(bs3(ii2), 7)
                                                      sTemp = Space$(56)
                                                      Mid$(sTemp, 1)  = Mid$(as3(ii), 19, 6)
                                                      Mid$(sTemp, 08) = Mid$(as3(ii), 13, 6)
                                                      Mid$(sTemp, 15) = Mid$(as3(ii), 07, 6)
                                                      Mid$(sTemp, 22) = Mid$(as3(ii), 01, 6)
                                                      Mid$(sTemp, 29) = Mid$(bs3(ii2), 01, 6)
                                                      Mid$(sTemp, 36) = Mid$(bs3(ii2), 07, 6)
                                                      Mid$(sTemp, 43) = Mid$(bs3(ii2), 13, 6)
                                                      Mid$(sTemp, 50) = Mid$(bs3(ii2), 19, 6)
                                      '                ? RTrim$(sTemp)
                                                End If
                                             Next
                                          Next
                                          '-----------------------------------------------------------
                                          'Now get fourth arrays of words that are 1 letter different from the last found arrays...
                                          '-----------------------------------------------------------
                                          For ii4 = 0 To index5 - 1
                                          For ii3 = 0 To %NUMBERofWORDS                  'starting with a2(), test it for any 1-letter-different matches
                                             If word6(ii3) = a3(ii4) Then
                                             For ii2 = 1 To 6
                                                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
                                                         a4(index7) = word6(ii)
                                                         as4(index7) = wordOrig6(ii) & as3(ii4)
                                                         Incr index7
                                                      End If
                                                   End If
                                                Next
                                             Next
                                             End If
                                          Next
                                          Next
                                          For ii4 = 0 To index6 - 1
                                          For ii3 = 0 To %NUMBERofWORDS                  'starting with b2(), test it for any 1-letter-different matches
                                             If word6(ii3) = b3(ii4) Then
                                             For ii2 = 1 To 6
                                                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
                                                         b4(index8) = word6(ii)
                                                         bs4(index8) = wordOrig6(ii) & bs3(ii4)
                                                         Incr index8
                                                      End If
                                                   End If
                                                Next
                                             Next
                                             End If
                                          Next
                                          Next
                                      'eliminate duplicates in a4() and as4() < this is the human readable version of a4()
                                          Array Sort a4(), TagArray as4()
                                          ii2 = 0
                                          For ii = 0 To %LASTaRRAYsIZE2 - 1
                                             If a4(ii) = 0 Then Iterate For
                                             If a4(ii) = a4(ii + 1) Then
                                                Iterate For
                                             Else
                                                a4(ii2) = a4(ii)
                                                as4(ii2) = as4(ii)
                                                Incr ii2
                                             End If
                                          Next
                                          If a4(%LASTaRRAYsIZE2 - 1) <> a4(%LASTaRRAYsIZE2) Then 'handle last element
                                             a4(ii2) = a4(%LASTaRRAYsIZE2)
                                             as4(ii2) = as4(%LASTaRRAYsIZE2)
                                             Incr ii2
                                          End If
                                          For ii = ii2 To %LASTaRRAYsIZE2
                                             a4(ii) = 0
                                             as4(ii) = ""
                                          Next
                                      'eliminate duplicates in b4() and bs4() < this is the human readable version of b4()
                                          Array Sort b4(), TagArray bs4()
                                          ii2 = 0
                                          For ii = 0 To %LASTaRRAYsIZE2 - 1
                                             If b4(ii) = 0 Then Iterate For
                                             If b4(ii) = b4(ii + 1) Then
                                                Iterate For
                                             Else
                                                b4(ii2) = b4(ii)
                                                bs4(ii2) = bs4(ii)
                                                Incr ii2
                                             End If
                                          Next
                                          If b4(%LASTaRRAYsIZE2 - 1) <> b4(%LASTaRRAYsIZE2) Then 'handle last element (1000)
                                             b4(ii2) = b4(%LASTaRRAYsIZE2)
                                             bs4(ii2) = bs4(%LASTaRRAYsIZE2)
                                             Incr ii2
                                          End If
                                          For ii = ii2 To %LASTaRRAYsIZE2
                                             b4(ii) = 0
                                             bs4(ii) = ""
                                          Next
                                      '   ? JOIN$(as4(), "  ")
                                      '   ? JOIN$(bs4(), "  ")
                                          ii3 = 0
                                          For ii = 0 To %LASTaRRAYsIZE2 - 1   'slow logic here just for demo purposes. If 4 of 5 letters are equal, just 1 change completes.
                                             If Asc(as4(ii)) < 65 Then Exit For
                                             For ii2 = 0 To %LASTaRRAYsIZE2 - 1
                                                If Asc(bs4(ii2)) < 65 Then Exit For
                                                If Asc(as4(ii), 1) = Asc(bs4(ii2), 1) And Asc(as4(ii), 2) = Asc(bs4(ii2), 2) And Asc(as4(ii), 3) = Asc(bs4(ii2), 3) _
                                                   And Asc(as4(ii), 4) = Asc(bs4(ii2), 4) And Asc(as4(ii), 5) = Asc(bs4(ii2), 5) Or _
                                                   Asc(as4(ii), 2) = Asc(bs4(ii2), 2) And Asc(as4(ii), 3) = Asc(bs4(ii2), 3) And Asc(as4(ii), 4) = Asc(bs4(ii2), 4) _
                                                   And Asc(as4(ii), 5) = Asc(bs4(ii2), 5) And Asc(as4(ii), 6) = Asc(bs4(ii2), 6) Or _
                                                   Asc(as4(ii), 1) = Asc(bs4(ii2), 1) And Asc(as4(ii), 3) = Asc(bs4(ii2), 3) And Asc(as4(ii), 4) = Asc(bs4(ii2), 4) _
                                                   And Asc(as4(ii), 5) = Asc(bs4(ii2), 5) And Asc(as4(ii), 6) = Asc(bs4(ii2), 6) Or _
                                                   Asc(as4(ii), 1) = Asc(bs4(ii2), 1) And Asc(as4(ii), 2) = Asc(bs4(ii2), 2) And Asc(as4(ii), 4) = Asc(bs4(ii2), 4) _
                                                   And Asc(as4(ii), 5) = Asc(bs4(ii2), 5) And Asc(as4(ii), 6) = Asc(bs4(ii2), 6)  Or _
                                                   Asc(as4(ii), 1) = Asc(bs4(ii2), 1) And Asc(as4(ii), 2) = Asc(bs4(ii2), 2) And Asc(as4(ii), 3) = Asc(bs4(ii2), 3) _
                                                   And Asc(as4(ii), 5) = Asc(bs4(ii2), 5) And Asc(as4(ii), 6) = Asc(bs4(ii2), 6) Then
                                                      If Left$(as4(ii), 6) = Left$(bs4(ii2), 6) Then bs4(ii2) = Mid$(bs4(ii2), 7)
                                                      sTemp = Space$(70)
                                                      Mid$(sTemp, 1)  = Mid$(as4(ii), 25, 6)
                                                      Mid$(sTemp, 8)  = Mid$(as4(ii), 19, 6)
                                                      Mid$(sTemp, 15) = Mid$(as4(ii), 13, 6)
                                                      Mid$(sTemp, 22) = Mid$(as4(ii), 07, 6)
                                                      Mid$(sTemp, 29) = Mid$(as4(ii), 01, 6)
                                                      Mid$(sTemp, 36) = Mid$(bs4(ii2), 01, 6)
                                                      Mid$(sTemp, 43) = Mid$(bs4(ii2), 07, 6)
                                                      Mid$(sTemp, 50) = Mid$(bs4(ii2), 13, 6)
                                                      Mid$(sTemp, 57) = Mid$(bs4(ii2), 19, 6)
                                                      Mid$(sTemp, 64) = Mid$(bs4(ii2), 25, 6)
                                                      Incr ii3
                                                      If ii3 < 8 Then 
                                      '                  ? "Note: Only up to eight sequences will be shown of possibly 100's" & $CrLf & $CrLf & _
                                      '                    RTrim$(sTemp)     'there can be hundreds, so ii3 limits it to 8 results
                                                      End If
                                                      '''
                                                      ReDim Preserve Sequences$(UBound(Sequences$) + 1)
                                                        Sequences$(UBound(Sequences$)) = RTrim$(sTemp)
                                                End If
                                             Next
                                          Next
                                      '        End of John's code
                                      
                                          t$ = " ": Set_Clipboard 'empty it
                                          Wait = 2000 
                                          If UBound(Sequences$) > 0 Then
                                             Array Sort Sequences$(0)
                                             t$ = " Answer Sequences" & $CrLf & $CrLf 
                                             For ctr = LBound(Sequences$) To UBound(Sequences$)
                                                t1$ = "  "
                                                If Ctr > LBound(Sequences$) Then
                                                   If Sequences$(ctr) = Sequences$(ctr - 1) Then
                                                      t1$ = "  (Duplicate)"  
                                                   End If 
                                                End If
                                                
                                                t$ = t$ & Sequences$(ctr) & t1$ & $CrLf 
                                             Next ctr                             
                                             Set_Clipboard
                                             Label_Set_Done                
                                             Sleep Wait
                                            Else
                                             Label_Set_No_Answer
                                             Sleep Wait
                                          End If
                                          Label_Set_Main 
                                      End Sub
                                      '------------------------------------------------------------------------------
                                      '   ** CallBacks **
                                      '------------------------------------------------------------------------------
                                      CallBack Function CB_Dialog_Processor()
                                          Common_Locals
                                          Select Case As Long CbMsg
                                              Case %WM_INITDIALOG
                                              Case %WM_COMMAND
                                                  ' Process control notifications
                                                  Select Case As Long CbCtl
                                                      Case %Btn_01
                                                        'Call WP_Answer 'Word_Progression_Puzzle
                                                        Call John_Solver
                                                      'Case %Word_Start
                                                        'm$ = "At Word":mb_Alert
                                                  End Select
                                          End Select
                                      End Function
                                      '------------------------------------------------------------------------------
                                      '
                                      Macro 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
                                            m$ = "Fill_G_Words_Array":m_Err_Msg
                                            
                                           ctr = Lof(#fnum)  
                                           If ctr = 0 Then
                                       '      m_beep
                                             m$ = fn$:m1$ = "File not found": mb 
                                             Close
                                             Exit Sub
                                           End If
                                           temp$ = Space$(ctr) 'make big string
                                           Get #fnum, 1, temp$
                                           Close #fnum     
                                           ctr = ParseCount(temp$, $CrLf)
                                           ReDim  g_Words$(ctr)
                                           Parse temp$,  g_Words$(), $CrLf          
                                      End Macro
                                      '
                                      '****************************************************************************
                                      '****************************************************************************
                                      Macro w_Build_Word_List
                                         Reset Word_List$
                                         For ctr = LBound(g_Words$) To UBound(g_Words$)
                                            Word_List$ = Word_List$ & g_Words$(ctr) & " "
                                         Next ctr  
                                         W1$ = Word_List$ 
                                      End Macro   
                                      '
                                      Sub WP_Answer
                                      '  Answer:  'note Number is the ascii value of the word 
                                       'THINK  
                                          'THICK  
                                          'TRICK  
                                          'TRACK  
                                          'TRACT  
                                          'TRAIT  
                                          'TRAIN  
                                       'BRAIN  
                                      '
                                      '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 
                                      'SWIMS-CRAMP. It produced SWIMS SLIMS SLAMS CLAMS CLAMP CRAMP.
                                         Common_Locals 
                                          g_Timer = Timer
                                         Label_Set_Working 
                                         W_Check_Words_Validity  'returns Word_len & g_Words$()
                                                               '   First_Word$, Last_Word$
                                         w_Build_Word_List       'returns Word_List$, w1$
                                         
                                         w$ = First_Word$ 
                                         Flag = 0
                                         'Maybe Do Loop
                                         While w$ <> Last_Word$
                                          w$ = Last_Word$ 
                                         
                                         '  W1$ = Word_List$
                                         '  While  'what?
                                         '
                                         '  wend 
                                         Wend
                                        m$ = Using$("Done #, # letter Words", UBound(g_Words$), Word_Len)
                                         m1$ = Using$("Took .## seconds ", Timer - g_timer)
                                          mb               
                                        Label_Set_Main
                                      End Sub
                                      '*****************
                                      '''Sub WPP_Answer
                                      ''''Union sixMax
                                      ''''   cLine As String * 4
                                      ''''   cLong As Long
                                      ''''End Union
                                      '''  Common_Locals
                                      '''
                                      '''  Local lineo As String
                                      '''  Local ii, ii2, ii3, ii4, index, index2, index3, index4, index5, index6, endLoop As Long
                                      '''  Local compressLineo As sixMax
                                      '''
                                      '''  Check_Words_Validity
                                      '''
                                      '''   Word_Len = 5
                                      '''
                                      '''  fn$ = CurDir$ & "\Words.txt"
                                      '''   m_Binary_Open  'puts file in fle$
                                      '''    Words_In_File = ParseCount(fle$, $Lf)         
                                      '''     Close
                                      '''    'total_Words_in_File$ =  $CrLf & Using$("#,###  Words in File", Words_In_File) & $CrLf 
                                      '''    
                                      '''    g_timer# = Timer
                                      '''
                                      '''  
                                      '''  Dim word6(Number_of_Words) As Long, wordOrig6(Number_of_Words) 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 CurDir$ & "\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 Number_of_Words                  '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 Number_of_Words
                                      '''             Incr Reps
                                      '''             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 Number_of_Words                  '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 Number_of_Words
                                      '''             Incr Reps
                                      '''             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 Number_of_Words                  '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 Number_of_Words
                                      '''             Incr Reps
                                      '''             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 Number_of_Words                  '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 Number_of_Words
                                      '''             Incr Reps
                                      '''             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
                                      '''       Incr Reps
                                      '''       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
                                      '''       Incr Reps
                                      '''       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
                                      '''       Incr Reps
                                      '''       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
                                      '''       Incr Reps
                                      '''       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 Number_of_Words                  'starting with a2(), test it for any 1-letter-different matches
                                      '''       If word6(ii3) = a2(ii4) Then
                                      '''       For ii2 = 1 To 5
                                      '''         Incr Reps
                                      '''          acacia(ii2) = word6(ii3) And blank(ii2)
                                      '''          For ii = 0 To Number_of_Words
                                      '''             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 Number_of_Words                  '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 Number_of_Words
                                      '''            Incr Reps
                                      '''             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
                                      '''     Incr Reps
                                      '''     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
                                      '''       Incr Reps
                                      '''       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
                                      '''       Incr Reps
                                      '''       b3(ii) = 0
                                      '''       bs3(ii) = ""
                                      '''    Next
                                      '''    '? t$ '& 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
                                      '''          Incr Reps
                                      '''          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
                                      '''            GoTo done
                                      '''          End If
                                      '''       Next
                                      '''    Next
                                      '''
                                      '''done:
                                      '''
                                      '''   sp$ = " - "
                                      '''   Reset t$                
                                      '''   t1$ = bs3(ii2) 'second half of solution
                                      '''   For ctr = 1 To Len(bs3(ii2)) Step Word_Len
                                      '''      t$ = t$ & sp$ & Mid$(t1$, ctr, Word_Len) & $CrLf 
                                      '''   Next x
                                      '''
                                      '''   t$ = t$ & Last_Word$
                                      '''   
                                      '''    m1$ = Using$("#,###  Words in File", Words_In_File) & $CrLf &  _
                                      '''          Using$("#, Operations", Reps) &  $CrLf & _
                                      '''          Using$("Took .## Seconds", Timer - G_Timer#) 
                                      '''               
                                      '''    m$ =  First_Word$ & $CrLf & _
                                      '''          sp$ & Mid$(as3(ii), 16, Word_len) & $CrLf & _
                                      '''          sp$ & Mid$(as3(ii), 11, 5) & $CrLf & _
                                      '''          sp$ & Mid$(as3(ii), 6, 5) & $CrLf & _
                                      '''          sp$ & Mid$(as3(ii), 1, 5) & $CrLf & _
                                      '''          t$ 
                                      '''          
                                      '''    mb      
                                      '''            
                                      '''
                                      '''    Close 'case file left open
                                      '''
                                      '''End Sub 
                                      '*************************************************************
                                      '------------------------------------------------------------------------------
                                      '   ** Dialogs **
                                      '------------------------------------------------------------------------------
                                      Function Main_Dialog(ByVal hParent As Dword) As Long
                                         Common_Locals
                                         'Local Row&, Col&, col1&, Wdth&, Hght&, tb_Len&, lbl$, m$, m1$
                                           Wdth = 300
                                           Hght = 150
                                          
                                          Dialog New Pixels, hDlg, "Word Progression Solver ", _
                                                 , , Wdth, Hght, _
                                                 %WS_SYSMENU, _
                                                 To hDlg
                                          Row = 12
                                          Col = 10                
                                          
                                         ' Label_Set_Solving
                                          Stile = %SS_CENTER 
                                          Control Add Label, hDlg, %Working_Label, lbl$, _
                                               Col + 175, Row, 100, %Box_Height * 4, _
                                               Stile
                                          
                                          Label_Set_Main
                                      '5 ltr    ''SWIMS-CRAMP. It produced SWIMS SLIMS SLAMS CLAMS CLAMP CRAMP.
                                      '   inWord  = UCASE$("creepy")
                                      '   outWord = UCASE$("shocks")
                                      '    inWord  = UCase$("voting")
                                      '    outWord = UCase$("server")
                                        t1$ = "Voting"
                                        t2$ = "Server"
                                        
                                          lbl$ = "  Starting Word " 
                                            tb_len = Len(lbl$) * 5
                                         
                                          Control Add Label, hDlg, -1, lbl$, _
                                               Col, Row, tb_len, %Box_Height
                                            Control Add TextBox, hDlg, %Word_Start, t1$, _
                                                Col + tb_len + 5, Row, tb_len, %Box_Height
                                          RSet lbl$ = "Finished Word "
                                          Row = Row + (%Box_Height * 2)
                                          Control Add Label, hDlg, -1, lbl$, _
                                               Col, Row, tb_len, %Box_Height
                                            Control Add TextBox, hDlg, %Word_Done, t2$, _
                                                Col + tb_len + 5, Row, tb_len, %Box_Height
                                      
                                          lbl$ = "&Solve Word Progression"
                                          Row = Row + (%Box_Height * 2)
                                          Control Add Button,  hDlg, %Btn_01, lbl$, _
                                              Col, Row, _
                                              Wdth - 20,  %Box_Height * 2
                                       
                                          Dialog Show Modal hDlg, Call CB_Dialog_Processor To lRslt
                                      
                                          Function = lRslt
                                      End Function
                                      '------------------------------------------------------------------------------
                                      Sub Back_Up  'use while working
                                        Common_locals
                                        t$ = "\Word_Progression.bas"
                                        fn$ = CurDir$ & t$
                                          fle$ =  "h:" & t$ '\Z-Post.bas" 
                                          FileCopy fn$, fle$             
                                            M$ = "Copied " & fn$  & $CrLf & _
                                               "to     " & fle$
                                            t1$ =  $CrLf  & String$(Len(m$), "*") & $CrLf 
                                            t$ =  t1$ & m$ & t1$ & $CrLf & t$
                                             mb_Alert
                                      End Sub
                                      '------------------------------------------------------------------------------
                                      '
                                      Sub Data_Words_into_Array(Word_Length&)
                                        Common_Locals                       
                                        g_timer = Timer
                                        fn$ = CurDir$ & "\Data_Words.txt"
                                         m_Input_Open 
                                         
                                      ' Exit Sub
                                        Erase g_Words$
                                         While Not Eof(fnum)   
                                           Input #fnum, flen, fn$ 'variables already declared so use them again
                                            If flen = Word_Length& Then
                                              ReDim Preserve g_Words$(UBound(g_Words$) + 1)
                                              g_Words$(UBound(g_Words$)) = fn$
                                            End If
                                         Wend 
                                         Close #fnum                                         '+1 as array is 0 bound
                                      '   m$ = Using$(" ##,### ## letter Words", UBound(g_Words$) + 1, Word_Length&)
                                      '   m1$ = Using$("Took .## seconds to build the array", Timer - g_timer)
                                      '   mb
                                         
                                      End Sub
                                      'Create data statements for use later
                                      Sub Data_Words_Create_File
                                        Common_Locals
                                        Fill_G_Words_Array   
                                         ReDim tmp(LBound(g_words) To UBound(g_Words))' As String * 30 'longest word
                                        'strip words of ascii values
                                        For ctr = LBound(g_words) To UBound(g_Words)
                                           RSet tmp$(Ctr)= Mid$(g_Words$(ctr), 7)
                                        Next ctr           
                                        Array Sort tmp$() 'now sort according to string length
                                        fn$ = CurDir$ & "\Data_Words.txt"
                                         m_Output_Open    
                                         ReDim Ttls&(2 To 30) 'largest word size
                                         
                                        For ctr = LBound(g_words) To UBound(g_Words)
                                           t$ = Trim$(tmp$(ctr)) 'convenience
                                           If Asc(t$) > 64 Then 'case of blank lines
                                              Incr ctr1
                                              Incr Ttls&(Len(t$))
                                              pf Using$(" ##", Len(t$)) & ", " & _
                                                 Trim$(tmp$(ctr))
                                           End If 
                                        Next ctr
                                        pf Using$(" ##", -1) & ", " & "End Words"   
                                        pf 'blank line
                                        pf  Using$("#, elements #, Data Words", UBound(g_Words), ctr1)
                                         'mb
                                        pf 
                                         'now put word count
                                        For ctr = LBound(ttls) To UBound (ttls)
                                           pf Using$("   ##,###  ## letter words ", ttls(ctr), ctr)
                                        Next ctr
                                       
                                         
                                        Close
                                        Erase tmp$ 'don't need it any more
                                      End Sub
                                       
                                      '------------------------------------------------------------------------------
                                      '   ** Main Application Entry Point **
                                      '------------------------------------------------------------------------------
                                      Function PBMain()
                                      '  Call Back_Up
                                      '   Call Data_Words_Create_File 'not needed anymore
                                          Common_Locals
                                          Main_Dialog %HWND_DESKTOP
                                      End Function
                                      '------------------------------------------------------------------------------
                                      
                                      '
                                      It's a pretty day. I hope you enjoy it.

                                      Gösta

                                      JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                      LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                      Comment


                                        #39
                                        John, After posting above a test occurred to me. I created a Sub Testing in your Program and copied the routine into it.

                                        Code:
                                        Function PBMain () As Long
                                         
                                          Call Testing
                                          ?"after Testing once"
                                          Call Testing
                                          ?"after Testing Twice"
                                        The first call worked (all msgboxes showed), but in the second the msgboxes were all blank. IOW they still showed but there was no text in them. They appeared to be the same sizes though.
                                        It's a pretty day. I hope you enjoy it.

                                        Gösta

                                        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                        Comment


                                          #40
                                          hmmm... I'll try it and see what I can find.

                                          Comment

                                          Working...
                                          X
                                          😀
                                          🥰
                                          🤢
                                          😎
                                          😡
                                          👍
                                          👎