Announcement

Collapse
No announcement yet.

Word Progression Puzzle

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

  • Word Progression Puzzle

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

    Here's a sample:

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

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

    Anyone have any thoughts on the logic.

    ============================================================
    "The only way to get rid of a temptation
    is to yield to it."
    Oscar Wilde (1854-1900)
    ============================================================
    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/

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

    What word has the lowest 'ascii' value. What word has the highest. In other words, what is the 'ascii' value range? Does this apply to only five letter words.
    Rod
    I want not 'not', not Knot, not Knott, not Nott, not knot, not naught, not nought, but aught.

    Comment


    • #3
      Originally posted by Rodney Hicks View Post
      Could you provide a little more detail? So far to me the logic is illogical. You have three words with the same 'ascii' value. How does the 'ascii' value help you? How do yo arrive at you 'ascii' value?
      Okay I should have been more clear. What I should have said is "Ascii Total" for each word instead of just "Ascii". Total = the total of all letters in the word. Probably instead of Ascii, the accurate term would have been "Hash".

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

      What word has the lowest 'ascii' value.
      THICK '371
      What word has the highest.
      TRAIT '388
      In other words, what is the 'ascii' value range?
      While I don't know, I'm guessing interim steps (though obviously not in this set) could range much farther.

      Does this apply to only five letter words.
      The puzzle in this case is 5 letter words. I've seen puzzles using other lengths. I'm just stumped in how to proceed. Just an interesting exercise in logic is all.
      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


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

        Comment


        • #5
          Originally posted by Elias Montoya View Post
          could you post the file with the words? that sounds like a good challenge.
          It is a challenge. {grin}

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

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

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

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

          =======================================================
          "Once you eliminate the impossible,
          whatever remains,
          no matter how improbable,
          must be the truth."
          Sherlock Holmes (by Sir Arthur Conan Doyle, 1859-1930)
          =======================================================
          Last edited by Gösta H. Lovgren-2; 16 Feb 2008, 09:50 PM.
          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


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

            A couple of points though.

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

            Rod
            Rod
            I want not 'not', not Knot, not Knott, not Nott, not knot, not naught, not nought, but aught.

            Comment


            • #7
              The frist step

              Word Progesssion Solving
              For example: 'THINK' into 'BRAIN'
              by changing one letter at a time
              ' Answer Sequence:
              'THINK 't1$
              'THICK
              'TRICK
              'TRACK
              'TRACT
              'TRAIT
              'TRAIN
              'BRAIN 't2$
              '
              Okay finding the first set of words in the progression is easy:
              Code:
              'Wrds$ holds all 5 letter words
               t3$ = t1$ & " = " 'holder
               s$ = t1$
              Find_Word: 
               For x = 1 To ln 'letter length - 5 in example
                  For y = 65 To 90 'A - Z
                    LSet s$ = t1$ 'first word
                    Mid$(s$, x) = Chr$(y)'try a letter
                    If InStr(Wrds$, s$) And _ 
                       s$ <> t1$ Then 'see if it fits
                       t3$ = t3$ & " " & s$ 'it does so display it
                    End If
                  Next y       
               Next x
              t3$ contains:
              THINK = CHINK THANK THICK THINE THING THINS

              We know THICK is the second step (because we already know the answer) in the progression but how does the algorithym know it? What's the next step?
              Last edited by Gösta H. Lovgren-2; 17 Feb 2008, 04:07 PM.
              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


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

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

                It looks lke a recursive solution might be good.

                Paul.

                Comment


                • #9
                  Your next step is to find 'BRAIN' and all the real words that exist with one letter difference.
                  Compare the two lists.
                  Mayhaps there is a word there with only three letters that need to be changed?(I'm not sure how your program will recognize it. And this is why I don't have time to figure it all out.)
                  If not, then look at those that need four letters changed, then five.
                  If we assume an average of six words from each word you will end up with the following
                  Code:
                  Beginning                                            1 word
                  first step                                  6 words
                  second step                                       36 words
                  third step                                        216 words
                  fourth step                                       1296 words
                  fifth step  a)                                    7776 words
                                  b)                                   check for your word
                  sixth step a)                                      46,656 words
                                 b)                                    check for your word
                  .
                  .
                  .
                  second last step                                         found your word.
                  last step                                              trace its parentage to your first word.
                  OR
                  Code:
                  beginning                        1 word(first)      AND       1 word(target)
                  first step                       6 words             "        6 words
                  second step                                  check for convergence
                  third step                      36 words            AND       36 words
                  fourth step                                   check for convergence
                  fifth step                       216 words          AND       216 words
                  sixth step                                  check for convergence or a match
                  seventh step                    1296 words           AND      1296 words
                  eighth step                              check for convergence or a match
                  .....
                  Nth step                                        found a match
                  Nth+1 step                        follow each parent to its parent to its parent....
                  The matched word and its parents are three of the words in the chain.
                  The matched word and its parents and their parents and their parents.....to the first and target words are your chain.
                  Rod
                  Rod
                  I want not 'not', not Knot, not Knott, not Nott, not knot, not naught, not nought, but aught.

                  Comment


                  • #10
                    Paul & Rod,

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

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

                    =====================================
                    " The best way to predict the future
                    is to invent it."
                    Alan Kay
                    =====================================
                    Last edited by Gösta H. Lovgren-2; 17 Feb 2008, 06:51 PM.
                    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


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


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

                      Comment


                      • #12
                        After first step

                        Word Progesssion Solving

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

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

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

                        After 910 Repetitions
                        THINK = CHINK THANK THICK THINE THING THINS

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


                        Here's the code snippet to arrive at above:
                        Code:
                           'Wrds$ holds all 5 letter words
                           't1$ = Starting Word
                           't2$ = Ending word 
                           Wrds$ = Remove$(Wrds$, t1$) 'want no duplicate matches
                           Wrds$ = Remove$(Wrds$, t2$)
                         
                         
                         t3$ = t1$ & " = " 'holder
                         t$ = t1$        
                         Reset ctr, flag  
                         ctr5 = 100
                         
                         Erase tmp$
                         GoSub Find_Word 'first step
                              'tmp$() returns with all possibles for the first word
                         
                         
                          For ctr = LBound(tmp$) To UBound(tmp$)  
                            t$ = tmp$(ctr) 't$ used in 
                            Reset t4$ 'will hold possibilities for t$ 
                            GoSub Find_Word1 'next steps
                            tmp$(ctr) = tmp$(ctr) & " = " & t4$ 'for display
                          Next ctr
                         
                           'for display
                          t$ = t5$ & $CrLf & $CrLf & _
                               Using$(" After #, Repetitions", Reps) & $CrLf & _
                               t3$ & $CrLf & $CrLf 
                         
                          For ctr = LBound(tmp$) To UBound(tmp$)  
                            t$ = t$ & Space$(ln) & tmp$(ctr) & $CrLf 
                          Next ctr
                         
                          't$ = t$ & $CrLf & $CrLf  & $CrLf &  _
                           '    Ans_Sequence$
                         Set_Text
                         Set_Clipboard
                        Exit Sub 
                        '
                        Find_Word1:                
                          s$ = tmp$(ctr)
                           For x = 1 To ln 'letter length - 5 in example
                              For y = 65 To 90 'A - Z
                                incr reps
                                LSet s$ = t$ 'word to find
                                Mid$(s$, x) = Chr$(y)'try a letter
                                If InStr(Wrds$, s$) Then 'see if it fits
                                  t4$ = t4$ & s$ & " "  'it does so display it
                                  Wrds$ = Remove$(Wrds$, s$)'don't use it again
                                End If
                              Next y       
                           Next x      
                         Return 
                        '
                         
                        Find_Word:
                         s$ = t$
                           For x = 1 To ln 'letter length - 5 in example
                              For y = 65 To 90 'A - Z
                                incr reps
                                LSet s$ = t$ 'word to find
                                Mid$(s$, x) = Chr$(y)'try a letter
                                If InStr(Wrds$, s$) Then 'see if it fits
                                   t3$ = t3$ & " " & s$ 'it does so display it
                                  ReDim Preserve tmp$(UBound(tmp$) + 1)
                                  tmp$(UBound(tmp$)) = s$
                                  Wrds$ = Remove$(Wrds$, s$)'don't use it again
                                End If
                              Next y       
                           Next x      
                         Return 
                        '
                        Am stumped on how to continue recursion. It's clear (because we know the answer) the progression (so far) is THINK to THICK to TRICK to ... but how does the program know that?

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


                        ============================================================
                        Why not be oneself?
                        That is the whole secret of a successful appearance.
                        If one is a greyhound,
                        why try to look like a Pekingese?
                        Edith Sitwell
                        ============================================================
                        Last edited by Gösta H. Lovgren-2; 18 Feb 2008, 09:28 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


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

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

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


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

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

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

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


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

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

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

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

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

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

                            Rod
                            Last edited by Rodney Hicks; 18 Feb 2008, 11:01 AM. Reason: just a thought
                            Rod
                            I want not 'not', not Knot, not Knott, not Nott, not knot, not naught, not nought, but aught.

                            Comment


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

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


                              • #16
                                Rod,

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

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


                                • #17
                                  Originally posted by Gösta H. Lovgren-2 View Post

                                  1) How did you arrive at the magic number of 11492? (as in word6(11492))
                                  11492 was the # of 6-letter words I found -1 for the 0 element.

                                  2) Why only read 54,000 lines in Words.txt? If it's the same file I use, there are 109,581 lines in it. Did you determine there were no 6 letter words after line 54,000? Just curious.
                                  Yes, I thought going like 30 grand past the last one I could find around 25,000 would be safe.

                                  Could you use a real world progression (such as THINK to BRAIN as in this case) as inputs. At least then I would have a better chance of following the logic, maybe not much but some anyway.
                                  Don't fret too much about the compression algorithm up at the top--it's just a way to get a six letter string into a 4-byte LONG, which we can really boogie with in our comparison algo. An analogy would be to think of the elements of word6() as, say, CVL("ACACIA"). It can't be done directly like that because ACACIA is 6 bytes and a LONG is 4 bytes, so I compressed it to fit.

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

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

                                  Comment


                                  • #18
                                    John,

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

                                    I just looked at it again to see if maybe I could use the compression stuff (no hope there for me I think) and noticed you had:
                                    Code:
                                        Open "C:\WINDOWS\Desktop\Words.txt" For Input Lock Shared As #1
                                    Since that isn't where Words.Txt is on my machine it yielded an (untrapped) error. No file read, no arrays to check, it went pretty fast.

                                    When I changed it to
                                    Code:
                                        Open CurDir$ & "\Words.txt" For Input Lock Shared As #1
                                    the elapsed time went from .00 to .35 which makes it only .1 sec faster than my routine. Still apples to oranges though as we are working with different arrays.
                                    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


                                    • #19
                                      Okay,

                                      Sticking with the actual puzzle rather than theoreticals:

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

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

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

                                      Turning out to be quite a quizzer, indeed.


                                      ============================================================
                                      Faith is the proof of sights unseen
                                      And the promise of things to come.
                                      William Shakespeare
                                      ============================================================
                                      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


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

                                        Code:
                                        #COMPILE EXE
                                        #DIM ALL
                                        
                                        UNION sixMax
                                           cLine AS STRING * 4
                                           cLong AS LONG
                                        END UNION
                                        
                                        %NUMBERofWORDS = 6919
                                        
                                        FUNCTION PBMAIN () AS LONG
                                          LOCAL lineo AS STRING, ii, ii2, ii3, ii4, index, index2, index3, index4, index5, index6, endLoop AS LONG
                                          LOCAL compressLineo AS sixMax
                                          DIM word6(%NUMBERofWORDS) AS LONG, wordOrig6(%NUMBERofWORDS) AS STRING, acacia(6) AS LONG, blank(6) AS LONG
                                          DIM a1(100) AS LONG, a2(1000) AS LONG, a3(1000) AS LONG
                                          DIM b1(100) AS LONG, b2(1000) AS LONG, b3(1000) AS LONG
                                          DIM as1(100) AS STRING, as2(1000) AS STRING, as3(1000) AS STRING
                                          DIM bs1(100) AS STRING, bs2(1000) AS STRING, bs3(1000) AS STRING
                                            OPEN "c:\Words.txt" FOR INPUT LOCK SHARED AS #1
                                            '-----------------------------------------------------------
                                            'put words in a fast to use LONG format and store in word6() array. 6 is max letters for this technique, and used here.
                                            'if 7 or more needed (12 max), the UNION would need to go to QUAD/8 and therefore be slower.
                                            '-----------------------------------------------------------
                                            FOR ii = 1 TO 54000
                                               LINE INPUT #1, lineo
                                               IF LEN(lineo) = 11 THEN                                'is it 6 letters long?
                                                  compressLineo.cLong = 0
                                                  ASC(compressLineo.cLine, 1) = ASC(lineo, 11) - &h40  'stuff each capital letter--1 to 26--into 5 bit space. (32 max for 5 bits)
                                                  ROTATE RIGHT compressLineo.cLong, 5
                                                  ASC(compressLineo.cLine, 1) = ASC(lineo, 10) - &h40  'stuff each capital letter--1 to 26--into 5 bit space. (32 max for 5 bits)
                                                  ROTATE RIGHT compressLineo.cLong, 5
                                                  ASC(compressLineo.cLine, 1) = ASC(lineo,  9) - &h40  'stuff each capital letter--1 to 26--into 5 bit space. (32 max for 5 bits)
                                                  ROTATE RIGHT compressLineo.cLong, 5
                                                  ASC(compressLineo.cLine, 1) = ASC(lineo,  8) - &h40  'stuff each capital letter--1 to 26--into 5 bit space. (32 max for 5 bits)
                                                  ROTATE RIGHT compressLineo.cLong, 5
                                                  ASC(compressLineo.cLine, 1) = ASC(lineo,  7) - &h40 + ASC(compressLineo.cLine, 1)  'last letter
                                                  ROTATE RIGHT compressLineo.cLong, 12
                                                  word6(index) = compressLineo.cLong
                                                  wordOrig6(index) = RIGHT$(lineo, 5)
                                                  INCR index
                                               END IF
                                            NEXT
                                            ? "Ready to go..."
                                        '    ? str$(index)
                                            '-----------------------------------------------------------
                                            'Array is now filled with all 6 letter words.
                                            'Next, see if "ACACIA" has any other words that are 1 letter different...
                                            '-----------------------------------------------------------
                                            blank(1) = &b11111111111111111111111111100000  'first make a mask to test each of 6 1-letter differences
                                            blank(2) = &b11111111111111111111110000011111
                                            blank(3) = &b11111111111111111000001111111111
                                            blank(4) = &b11111111111100000111111111111111
                                            blank(5) = &b11111110000011111111111111111111
                                            blank(6) = &b11000001111111111111111111111111
                                        
                                            index = 0
                                            FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with THINK, test it for any 1-letter-different matches
                                               IF wordOrig6(ii3) = "THINK" THEN
                                               FOR ii2 = 1 TO 5
                                                  acacia(ii2) = word6(ii3) AND blank(ii2)
                                                  FOR ii = 0 TO %NUMBERofWORDS
                                                     IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                                                        IF ii <> ii3 THEN                     'eliminate match with itself
                                                           a1(index) = word6(ii)
                                                           as1(index) = wordOrig6(ii) & "THINK"
                                                           INCR index
                                                        END IF
                                                     END IF
                                                  NEXT
                                               NEXT
                                               END IF
                                            NEXT
                                        
                                           index2 = 0
                                            FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with BRAIN, test it for any 1-letter-different matches
                                               IF wordOrig6(ii3) = "BRAIN" THEN
                                               FOR ii2 = 1 TO 5
                                                  acacia(ii2) = word6(ii3) AND blank(ii2)
                                                  FOR ii = 0 TO %NUMBERofWORDS
                                                     IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                                                        IF ii <> ii3 THEN                     'eliminate match with itself
                                                           b1(index2) = word6(ii)
                                                           bs1(index2) = wordOrig6(ii) & "BRAIN"
                                                           INCR index2
                                                        END IF
                                                     END IF
                                                  NEXT
                                               NEXT
                                               END IF
                                            NEXT
                                        
                                            ? JOIN$(as1(), "  ") & $CRLF & JOIN$(bs1(), "  ")
                                        
                                            '-----------------------------------------------------------
                                            'Now get second arrays of words that are 1 letter different from the previously found arrays...
                                            '-----------------------------------------------------------
                                            FOR ii4 = 0 TO index - 1
                                            FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with a1(), test it for any 1-letter-different matches
                                               IF word6(ii3) = a1(ii4) THEN
                                               FOR ii2 = 1 TO 5
                                                  acacia(ii2) = word6(ii3) AND blank(ii2)
                                                  FOR ii = 0 TO %NUMBERofWORDS
                                                     IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                                                        IF ii <> ii3 THEN                     'eliminate match with itself
                                                           a2(index3) = word6(ii)
                                                           as2(index3) = wordOrig6(ii) & as1(ii4)
                                                           INCR index3
                                                        END IF
                                                     END IF
                                                  NEXT
                                               NEXT
                                               END IF
                                            NEXT
                                            NEXT
                                        
                                            FOR ii4 = 0 TO index2 - 1
                                            FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with b(1), test it for any 1-letter-different matches
                                               IF word6(ii3) = b1(ii4) THEN
                                               FOR ii2 = 1 TO 5
                                                  acacia(ii2) = word6(ii3) AND blank(ii2)
                                                  FOR ii = 0 TO %NUMBERofWORDS
                                                     IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                                                        IF ii <> ii3 THEN                     'eliminate match with itself
                                                           b2(index4) = word6(ii)
                                                           bs2(index4) = wordOrig6(ii) & bs1(ii4)
                                                           INCR index4
                                                        END IF
                                                     END IF
                                                  NEXT
                                               NEXT
                                               END IF
                                            NEXT
                                            NEXT
                                        
                                        'eliminate duplicates in a2() and as2() < this is the human readable version of a2()
                                            ARRAY SORT a2(), TAGARRAY as2()
                                            ii2 = 0
                                            FOR ii = 0 TO 1000 - 1
                                               IF a2(ii) = 0 THEN ITERATE FOR
                                               IF a2(ii) = a2(ii + 1) THEN
                                                  ITERATE FOR
                                               ELSE
                                                  a2(ii2) = a2(ii)
                                                  as2(ii2) = as2(ii)
                                                  INCR ii2
                                               END IF
                                            NEXT
                                            IF a2(999) <> a2(1000) THEN 'handle last element
                                               a2(ii2) = a2(1000)
                                               as2(ii2) = as2(1000)
                                               INCR ii2
                                            END IF
                                            FOR ii = ii2 TO 1000
                                               a2(ii) = 0
                                               as2(ii) = ""
                                            NEXT
                                        'eliminate duplicates in b2() and bs2() < this is the human readable version of b2()
                                            ARRAY SORT b2(), TAGARRAY bs2()
                                            ii2 = 0
                                            FOR ii = 0 TO 1000 - 1
                                               IF b2(ii) = 0 THEN ITERATE FOR
                                               IF b2(ii) = b2(ii + 1) THEN
                                                  ITERATE FOR
                                               ELSE
                                                  b2(ii2) = b2(ii)
                                                  bs2(ii2) = bs2(ii)
                                                  INCR ii2
                                               END IF
                                            NEXT
                                            IF b2(999) <> b2(1000) THEN 'handle last element (1000)
                                               b2(ii2) = b2(1000)
                                               bs2(ii2) = bs2(1000)
                                               INCR ii2
                                            END IF
                                            FOR ii = ii2 TO 1000
                                               b2(ii) = 0
                                               bs2(ii) = ""
                                            NEXT
                                            ? JOIN$(as2(), "  ") & $CRLF & JOIN$(bs2(), "  ")
                                        
                                            '-----------------------------------------------------------
                                            'Now get third arrays of words that are 1 letter different from the last found arrays...
                                            '-----------------------------------------------------------
                                            FOR ii4 = 0 TO index3 - 1
                                            FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with a2(), test it for any 1-letter-different matches
                                               IF word6(ii3) = a2(ii4) THEN
                                               FOR ii2 = 1 TO 5
                                                  acacia(ii2) = word6(ii3) AND blank(ii2)
                                                  FOR ii = 0 TO %NUMBERofWORDS
                                                     IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                                                        IF ii <> ii3 THEN                     'eliminate match with itself
                                                           a3(index5) = word6(ii)
                                                           as3(index5) = wordOrig6(ii) & as2(ii4)
                                                           INCR index5
                                                        END IF
                                                     END IF
                                                  NEXT
                                               NEXT
                                               END IF
                                            NEXT
                                            NEXT
                                        
                                            FOR ii4 = 0 TO index4 - 1
                                            FOR ii3 = 0 TO %NUMBERofWORDS                  'starting with b2(), test it for any 1-letter-different matches
                                               IF word6(ii3) = b2(ii4) THEN
                                               FOR ii2 = 1 TO 5
                                                  acacia(ii2) = word6(ii3) AND blank(ii2)
                                                  FOR ii = 0 TO %NUMBERofWORDS
                                                     IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                                                        IF ii <> ii3 THEN                     'eliminate match with itself
                                                           b3(index6) = word6(ii)
                                                           bs3(index6) = wordOrig6(ii) & bs2(ii4)
                                                           INCR index6
                                                        END IF
                                                     END IF
                                                  NEXT
                                               NEXT
                                               END IF
                                            NEXT
                                            NEXT
                                        
                                        'eliminate duplicates in a3() and as3() < this is the human readable version of a3()
                                            ARRAY SORT a3(), TAGARRAY as3()
                                            ii2 = 0
                                            FOR ii = 0 TO 1000 - 1
                                               IF a3(ii) = 0 THEN ITERATE FOR
                                               IF a3(ii) = a3(ii + 1) THEN
                                                  ITERATE FOR
                                               ELSE
                                                  a3(ii2) = a3(ii)
                                                  as3(ii2) = as3(ii)
                                                  INCR ii2
                                               END IF
                                            NEXT
                                            IF a3(999) <> a3(1000) THEN 'handle last element
                                               a3(ii2) = a3(1000)
                                               as3(ii2) = as3(1000)
                                               INCR ii2
                                            END IF
                                            FOR ii = ii2 TO 1000
                                               a3(ii) = 0
                                               as3(ii) = ""
                                            NEXT
                                        'eliminate duplicates in b3() and bs3() < this is the human readable version of b3()
                                            ARRAY SORT b3(), TAGARRAY bs3()
                                            ii2 = 0
                                            FOR ii = 0 TO 1000 - 1
                                               IF b3(ii) = 0 THEN ITERATE FOR
                                               IF b3(ii) = b3(ii + 1) THEN
                                                  ITERATE FOR
                                               ELSE
                                                  b3(ii2) = b3(ii)
                                                  bs3(ii2) = bs3(ii)
                                                  INCR ii2
                                               END IF
                                            NEXT
                                            IF b3(999) <> b3(1000) THEN 'handle last element (1000)
                                               b3(ii2) = b3(1000)
                                               bs3(ii2) = bs3(1000)
                                               INCR ii2
                                            END IF
                                            FOR ii = ii2 TO 1000
                                               b3(ii) = 0
                                               bs3(ii) = ""
                                            NEXT
                                            ? JOIN$(as3(), "  ") & $CRLF & JOIN$(bs3(), "  ")
                                            
                                            FOR ii = 1 TO 200           'slow logic here just for demo purposes. If 4 of 5 letters are equal, just 1 change completes.
                                               FOR ii2 = 1 TO 200
                                                  IF ASC(as3(ii), 1) = ASC(bs3(ii2), 1) AND ASC(as3(ii), 2) = ASC(bs3(ii2), 2) AND ASC(as3(ii), 3) = ASC(bs3(ii2), 3) _
                                                  AND ASC(as3(ii), 4) = ASC(bs3(ii2), 4) THEN
                                                     ? MID$(as3(ii), 16) & MID$(as3(ii), 11, 5) & MID$(as3(ii), 6, 5) & MID$(as3(ii), 1, 5) & bs3(ii2)
                                                     GOTO done
                                                  END IF
                                               NEXT
                                            NEXT
                                            done:
                                        
                                        END FUNCTION

                                        Comment

                                        Working...
                                        X