Finding valid words in a set random grid

[bplus]

bplus.............Thank you for your last 2 posts. Don't worry about scoring and remember this is NOT boggle (just similar), it's a solo player game.

As you say the dictionaries can turn out some pretty obscure words, so I'm using unixdict (at present) which sticks to 'english' and more commonly used words



I have start formatting some code based on the directional movements/characteristics of the 9 different tile types and although it is beginning to do what I want I can see that I am going to hit problems further down the road. But I'll persevere until I hit a 'wall'. I think that the idea is similar to your explanation, but I'm going to end up with 'variable' problems keeping track of 'done' directions etc.

OK dkl , we might be playing different variations of game. I will start my own Boggle thread if I get this WordBuildOK function working, now that you've got me sucked into this thing ;-)) Really it's the coolest part in the coding effort of this game, the dictionary lookups, the GUI... nothing different than what we do in any game. Setup and display board get user clicked letter, string it up... ho hum :-))

I do have the unixdict.txt and it failed with a couple 3 letter words, my specialty with this game ;-))
unixdict.txt has not "has"! Either that of I accidently cut it from the file, NO!
I wouldn't mind if someone could confirm this with their unixdict.txt (used for Rosetta Code challenges).

I ran preliminary tests last night and almost have FindCell and WordBuildOK working in LB but I guess I do need to construct and pass the current work board with used letters blanked out to particular instances of the recursive FindCell. One global Work$() array needs to update state of board for each call to FindCell which requires parameter passing for stack to save instances. So I have to pack the board into a string and unpack it again into an instance (snapshot) of the board with the various blanked out cells accurate to that point of the call to FindCell. Oh lord, the troubles I get myself into! If all the letters were unique I'm sure this wouldn't be necessary.

[bplus]

JB/LB version of WordBuildOK and FindCell functions plus Basic Boggle board setup to test letter combinations.

' Boggle proof of concept b+ 2022-05-18
Dim dx(7), dy(7), Di$(16), Numbers(16), Board$(4, 4), Work$(5, 5)

Call NewBoard
call DisplayBoard
do
   'clear old lines we used
   locate 1, 6 : print space$(100)
   locate 1, 8: print space$(100)
   locate 1, 6
   Input "Enter a word constructed from board ";try$
   try$ = upper$(try$)
   locate 1, 8: print space$(50)
   if WordBuildOK(try$) then
       locate 1, 8 : print try$;" can be constructed on board."
   else
       locate 1, 8 : print try$;" can not be constructed on board."
   end if
   print
   Input "Press enter when ready for next test..." ; wate$
   locate 1, 10: Print space$(100)
loop while try$ <> ""
end

Sub NewBoard
       ' load dx(), dy() for testing the legality of words built from board
       dx(0) = -1: dy(0) = -1 ' this is for AI to find words
       dx(1) = 0: dy(1) = -1
       dx(2) = 1: dy(2) = -1
       dx(3) = -1: dy(3) = 0
       dx(4) = 1: dy(4) = 0
       dx(5) = -1: dy(5) = 1
       dx(6) = 0: dy(6) = 1
       dx(7) = 1: dy(7) = 1

       ' These are the 17 Dice with 6 Faces of a Letter need for Boggle
       Di$(0) = "PACEMD"
       Di$(1) = "RIFOBX"
       Di$(2) = "IFEHEY"
       Di$(3) = "DENOWS"
       Di$(4) = "UTOKND"
       Di$(5) = "HMSRAO"
       Di$(6) = "LUPETS"
       Di$(7) = "ACITOA"
       Di$(8) = "YLGKUE"
       Di$(9) = "QBMJOA"
       Di$(10) = "EHISPN"
       Di$(11) = "VETIGN"
       Di$(12) = "BALIYT"
       Di$(13) = "EZAVND"
       Di$(14) = "RALESC"
       Di$(15) = "UWILRG"
       Di$(16) = "AEIOUU" ' b+ mod Boggle 2 to remove all special handling of Q words!!!

       For i = 0 To 16
           Numbers(i) = i
       Next

   ''now get the game going
   For i = 16 To 1 Step -1 'shuffle die
       t = Numbers(i) : r = int(Rnd(0) * (i + 1))
       Numbers(i) = Numbers(r)
       Numbers(r) = t
   Next
   'For i = 1 To 16: Print Numbers(i),: Next: Print   ' check the shuffle
   For i = 0 To 15 'choosing random face of die = 1 Letter
       call Index2ColRow i, c, r
       Board$(c, r) = Mid$(Di$(Numbers(i)), Int(Rnd(0) * 6) + 1, 1) ' one die gets is left out now Boggle 2
   Next

End Sub

Sub DisplayBoard
   print
   For row = 1 To 4 '  display the board
       For col = 1 To 4
           Print " ";Board$(col, row);
       Next
       print
   Next
End Sub

Sub DisplayWork ' for debug only
   For row = 1 To 4 '  display the board
       locate 20, row+1 : print space$(50);
       For col = 1 To 4
           locate 20+2*col, row+1: Print " ";Work$(col, row);
       Next
       print
   Next
   locate 1, 20 : Input " Current Work$ array, press enter ";wate$
End Sub

' used
Sub Index2ColRow indexIn, byref rowOut, byref colOut 'convert die index to board col, row
   colOut = (indexIn Mod 4) + 1 : rowOut = int(indexIn / 4) + 1
End Sub

' This function checks to see that the word w$ is legally constructable with the given board.
' This function requires the recurive Function findCell& (startX As Long, startY As Long, word$, index As Long, Arr$())
Function WordBuildOK(w$)
   If Len(w$) < 3 Then Exit Function ' words need to be 3 letters
   For r = 1 To 4
       For c = 1 To 4
           Work$(c, r) = Board$(c, r)
           bs$ = bs$ + Board$(c, r) ' bs = Board String
       Next
   Next
   'locate 1, 20 : Print bs$
   'input "bs$ from WordBuildOK Press enter"; wate$
   first$ = Mid$(w$, 1, 1)
   For r = 1 To 4
       For c = 1 To 4
           If Work$(c, r) = first$ Then 'cell letter matches first letter in word
               test = findCell(c, r, w$, 2, bs$)
               If test Then
                   WordBuildOK = 1: Exit Function
               else 'rebuild Work$ again because call to findCell will change it
                   For row = 1 To 4
                       For col = 1 To 4
                           Work$(col, row) = Board$(col, row)
                       Next
                   Next
               end if
           End If
       Next
   Next
End Function

'recursively called starting from wordBuildOK
Function findCell(startX, startY, word$, index, boardStr$) ' want to setup recursive searcher

   If index > Len(word$) Then findCell = 1: Exit Function ' we are done and found the whole word

   'unpack boardStr$ and update Work$ with current boardStr$
   i = 1
   For r = 1 To 4
       For c = 1 To 4
           Work$(c, r) = mid$(boardStr$, i, 1) 'cell letter matches first letter in word
           i = i + 1
       Next
   Next

   Work$(startX, startY) = " " 'so wont be used again

   ' now pack that back into a string bs$ for next call to findCell
   bs$ = ""
   For r = 1 To 4
       For c = 1 To 4
           bs$ = bs$ + Work$(c, r)
       Next
   Next
   'call DisplayWork  ' debug OK I think I have things fixed for JB

   For d = 0 To 7
       If Work$(startX + dx(d), startY + dy(d)) = Mid$(word$, index, 1) Then 'found a potential next letter
           test = findCell(startX + dx(d), startY + dy(d), word$, index + 1, bs$)
           If test Then
               findCell = 1: Exit Function
           else 'rebuild work$
               i = 1
               For r = 1 To 4
                   For c = 1 To 4
                       Work$(c, r) = mid$(boardStr$, i, 1) 'cell letter matches first letter in word
                       i = i + 1
                   Next
               Next
               Work$(startX, startY) = " "
           end if
       End If
   Next
End Function




[bplus]

OK I got this far, may be fun to see what unixdict.txt words can be found in these boards.

Hey yeah, most of the words are known to me!

' Boggle words possible.txt b+ 2022-05-19
' Boggle proof of concept b+ 2022-05-18 proved!for Just Basic so therefore LB

Global topWord
Dim dWords$(25104), dx(7), dy(7), Di$(16), Numbers(16), Board$(4, 4), Work$(5, 5)

print "About a .5 minute to load the dictionary..."
timeStart = time$("ms")
open "unixdict.txt" for input as #1 'load dictionary
input #1, wd$
close #1
start = 1
p = instr(wd$, chr$(10), start)
while p > 0
   scan
   w$ = mid$(wd$, start, p - start)
   'print w$
   i = i + 1
   dWords$(i) = upper$(w$)
   start = p + 1
   p = instr(wd$, chr$(10), start)
wend
i = i + 1
dWords$(i) = upper$(mid$(wd$, start))
topWord = i
print (time$("ms") - timeStart)/1000;" secs, topWord # = ";topWord
for i = 1 to 10
print dWords$(i)
next
for i = topWord-10 to topWord
print dWords$(i)
next
print "end of file."
input "Press enter to draw up a board and try some words, q for quit and see words found in dictionary..."; wate$

[restart]
cls
Call NewBoard
call DisplayBoard
do
   'clear old lines we used
   locate 1, 6 : print space$(100)
   locate 1, 8: print space$(100)
   locate 1, 6
   Input "Enter a word constructed from board: ";try$
   try$ = upper$(try$)
   locate 1, 8: print space$(50)
   if WordBuildOK(try$) then
       locate 1, 8 : print try$;" can be constructed on board."
   else
       locate 1, 8 : print try$;" can not be constructed on board."
   end if
   print
   Input "Enter q to quit, Press enter when ready for next test..." ; wate$
   locate 1, 10: Print space$(100)
   if wate$ = "q" then exit do
loop while try$ <> ""
locate 1, 8: Print space$(100)
locate 1, 8: Print "unixdict.txt words found on this board:"
locate 1, 10
call AIwords
print: print: input "Go around again with a new board, y for yes ";wate$
if wate$ = "y" then
   goto [restart]
else
   print: print "End of Run, thanks for playing."
end if
end

Sub NewBoard
       ' load dx(), dy() for testing the legality of words built from board
       dx(0) = -1: dy(0) = -1 ' this is for AI to find words
       dx(1) = 0: dy(1) = -1
       dx(2) = 1: dy(2) = -1
       dx(3) = -1: dy(3) = 0
       dx(4) = 1: dy(4) = 0
       dx(5) = -1: dy(5) = 1
       dx(6) = 0: dy(6) = 1
       dx(7) = 1: dy(7) = 1

       ' These are the 17 Dice with 6 Faces of a Letter need for Boggle
       Di$(0) = "PACEMD"
       Di$(1) = "RIFOBX"
       Di$(2) = "IFEHEY"
       Di$(3) = "DENOWS"
       Di$(4) = "UTOKND"
       Di$(5) = "HMSRAO"
       Di$(6) = "LUPETS"
       Di$(7) = "ACITOA"
       Di$(8) = "YLGKUE"
       Di$(9) = "QBMJOA"
       Di$(10) = "EHISPN"
       Di$(11) = "VETIGN"
       Di$(12) = "BALIYT"
       Di$(13) = "EZAVND"
       Di$(14) = "RALESC"
       Di$(15) = "UWILRG"
       Di$(16) = "AEIOUU" ' b+ mod Boggle 2 to remove all special handling of Q words!!!

       For i = 0 To 16
           Numbers(i) = i
       Next

   ''now get the game going
   For i = 16 To 1 Step -1 'shuffle die
       t = Numbers(i) : r = int(Rnd(0) * (i + 1))
       Numbers(i) = Numbers(r)
       Numbers(r) = t
   Next
   'For i = 1 To 16: Print Numbers(i),: Next: Print   ' check the shuffle
   For i = 0 To 15 'choosing random face of die = 1 Letter
       call Index2ColRow i, c, r
       Board$(c, r) = Mid$(Di$(Numbers(i)), Int(Rnd(0) * 6) + 1, 1) ' one die gets is left out now Boggle 2
   Next

End Sub

Sub DisplayBoard
   print
   For row = 1 To 4 '  display the board
       For col = 1 To 4
           Print " ";Board$(col, row);
       Next
       print
   Next
End Sub

Sub DisplayWork ' for debug only
   For row = 1 To 4 '  display the board
       locate 20, row+1 : print space$(50);
       For col = 1 To 4
           locate 20+2*col, row+1: Print " ";Work$(col, row);
       Next
       print
   Next
   locate 1, 20 : Input " Current Work$ array, press enter ";wate$
End Sub

' used
Sub Index2ColRow indexIn, byref rowOut, byref colOut 'convert die index to board col, row
   colOut = (indexIn Mod 4) + 1 : rowOut = int(indexIn / 4) + 1
End Sub

' This function checks to see that the word w$ is legally constructable with the given board.
' This function requires the recurive Function findCell& (startX As Long, startY As Long, word$, index As Long, Arr$())
Function WordBuildOK(w$)
   If Len(w$) < 3 Then Exit Function ' words need to be 3 letters
   For r = 1 To 4
       For c = 1 To 4
           Work$(c, r) = Board$(c, r)
           bs$ = bs$ + Board$(c, r) ' bs = Board String
       Next
   Next
   'locate 1, 20 : Print bs$
   'input "bs$ from WordBuildOK Press enter"; wate$
   first$ = Mid$(w$, 1, 1)
   For r = 1 To 4
       For c = 1 To 4
           If Work$(c, r) = first$ Then 'cell letter matches first letter in word
               test = findCell(c, r, w$, 2, bs$)
               If test Then
                   WordBuildOK = 1: Exit Function
               else 'rebuild Work$ again because call to findCell will change it
                   For row = 1 To 4
                       For col = 1 To 4
                           Work$(col, row) = Board$(col, row)
                       Next
                   Next
               end if
           End If
       Next
   Next
End Function

'recursively called starting from wordBuildOK&
Function findCell(startX, startY, word$, index, boardStr$) ' want to setup recursive searcher

   If index > Len(word$) Then findCell = 1: Exit Function ' we are done and found the whole word

   'unpack boardStr$ and update Work$ with current boardStr$
   i = 1
   For r = 1 To 4
       For c = 1 To 4
           Work$(c, r) = mid$(boardStr$, i, 1) 'cell letter matches first letter in word
           i = i + 1
       Next
   Next

   Work$(startX, startY) = " " 'so wont be used again

   ' now pack that back into a string bs$ for next call to findCell
   bs$ = ""
   For r = 1 To 4
       For c = 1 To 4
           bs$ = bs$ + Work$(c, r)
       Next
   Next
   'call DisplayWork  ' debug OK I think I have things fixed for JB

   For d = 0 To 7
       If Work$(startX + dx(d), startY + dy(d)) = Mid$(word$, index, 1) Then 'found a potential next letter
           test = findCell(startX + dx(d), startY + dy(d), word$, index + 1, bs$)
           If test Then
               findCell = 1: Exit Function
           else 'rebuild work$
               i = 1
               For r = 1 To 4
                   For c = 1 To 4
                       Work$(c, r) = mid$(boardStr$, i, 1) 'cell letter matches first letter in word
                       i = i + 1
                   Next
               Next
               Work$(startX, startY) = " "
           end if
       End If
   Next
End Function

sub AIwords  'returns a space delimiter string of words that can be constructed from board

   'ub = UBound(WordList$)  now is NTopWord
   ' get a non redundant list of letters from board and put them in alpha order
   For r = 1 To 4
       For c = 1 To 4
           l$ = Board$(c, r)
           If (r = 1) And (c = 1) Then
               letters$ = l$
           Else
               If InStr(letters$, l$) <= 0 Then '  insrt letter
                   OK = 0
                   For i = 1 To Len(letters$) '            where?
                       If Asc(l$) < Asc(mid$(letters$, i, 1)) Then ' here!
                           letters$ = Mid$(letters$, 1, i - 1) + l$ + Mid$(letters$, i)
                           OK = -1: Exit For
                       End If
                   Next
                   If OK = 0 Then letters$ = letters$ + l$
               End If
           End If
       Next
   Next
   'check if this is OK so far  OK finally!  This is 3rd time I needed to exit when found
   Print "Board Letters: "; letters$
   Print
   'now letters of board are in alpha order
   dp = 1 'place in dict
   For l = 1 To Len(letters$) ' advance place in list$ by one until the word > letter
       wd$ = dWords$(dp)
       While Asc(wd$) < Asc(mid$(letters$, l, 1))
           scan
           dp = dp + 1
           If dp > topWord Then exit sub
           wd$ = dWords$(dp)
       Wend
       'now start testing words
       While Asc(wd$) = Asc(mid$(letters$, l, 1))
           scan
           If WordBuildOK(wd$) Then
               print wd$,
               wCount = wCount + 1
               if wCount mod 8 = 0 then print
           End If
           dp = dp + 1
           If dp > topWord Then exit sub
           wd$ = dWords$(dp)
       Wend
   Next
End sub


OK so you will need the unixdict.txt and a screen shot where GOLD was found!

Attachments:

[bplus]

OK you might need the unixdict.txt

Attachments:

Boggle with unixdict.zip (78.88 KB)

[David Drake]

Here's a link to my VERY crude and unintelligent Boggle-like game. It uses a brute-force randomization method to find words in a grid of random letters.

It may be of some use.

David

www.kkb9.com/lcf/downloads/boggle.zip

[bplus]

david Drake Link does not work, curious how you confirmed you could build word from board? ie if just random, how do you know you didn't repeat a letter?

Update (2022-05-21): OK I went to site and then clicked Boggle.zip and got something...

[tsh73]

Here's my turn on it
Promised backtracking, got rather messy. Needs unixdict in current directory.
Output on DKL example:
(it filters off whole dictionary for unvanted characters so rather slow to start)
Read 24819 words
time taken 4750 ms
-------
C S X S
T A Y E


-------
start at 1 1 c
Found: cat
Found: cast
start at 2 1 s
Found: say
Found: sat
Found: sac
Found: sax
Found: stay
Found: scat
start at 3 1 x
start at 4 1 s
Found: sex
Found: sexy
start at 1 2 t
Found: tax
start at 2 2 a
Found: aye
Found: acs
Found: act
Found: acts
Found: axe
Found: axes
start at 3 2 y
start at 4 2 e
Found: exact
start at 1 3
start at 2 3
start at 3 3
start at 4 3
start at 1 4
start at 2 4
start at 3 4
start at 4 4
-- OVER --

'Boggle backtracking
'tsh73 May 2022
'needs standart unixdict file
'valid words   24819

global nWords
nWords = 24819
dim dict$(nWords)

gosub [readWords]
'gosub [checkWords]

gosub [mkDirArray]

'4 4-letter words
board$ = "WRMO EGSD EYEI OOSD" 'b+ example
board$ = "CSXS TAYE"            'dkl example
'Take these 2 rows of 4. One can make the following words by using the adjacent letter in any available direction.
'CAT, CATS, CAST, TAX. SAY, YES, SEX, TAY, AYE, AXE, AXES, SAT, STAY.

brdSize=4
dim c$(brdSize,brdSize)

gosub [setBoard]
gosub [printBoard]

maxPath=brdSize*brdSize
dim path(maxPath), Xs(maxPath), Ys(maxPath)

for startY=1 to brdSize
   for startX=1 to brdSize
   'search for words from this

[init]
   cur = 1
   curX = startX:curY=startY
   Xs(cur)=curX:Ys(cur)=curY
   used$=" ";curX;curY
   w$ = c$(curY, curX)    'row col
   print "start at ";curX;" ";curY;" ";w$

while 1
[step]
   dir = 0
   path(cur)=dir
[chkDir]
   x=curX+dx(dir)
   y=curY+dy(dir)
   if not(x>0 and x<=brdSize and y>0 and y<=brdSize) goto [noGood]
   'some checks to prevent looping
   if instr(used$,"";x;y) then goto [noGood] 'not in dict
   'new word
   w$=left$(w$, cur)+c$(y, x)    'row col
   'is in dictionary
   gosub [findWord]
   if found <0 then goto [noGood] 'not in dict
   if found >0 then
       print "Found: "; w$
   end if
   curX=x: curY=y
   used$=used$;" ";curX;curY
   cur=cur+1
   Xs(cur)=curX:Ys(cur)=curY
   goto [step]
[noGood]
   'try another direction
   if path(cur) <7 then
       dir=path(cur)+1
       path(cur)=dir
       goto [chkDir]
   else
       'go back
       if cur<=1 then 'all paths exausted
           exit while
       else
           'print ,"backtrack"
           cur = cur-1
           used$=left$(used$,cur*3)
           curX=Xs(cur):curY=Ys(cur)
           goto [noGood]
       end if
   end if

wend

   next startX
next startY

print "-- OVER --"
a$=input$(1)

end

[readWords]
   fname$ = "unixdict.txt"
   t0=time$("ms")
   open fname$ for input as #2
   i=0
   while not(eof(#2))
       if i >nWords then
           print "ERROR: lines left but already read "; nWords;" words"
           close #2
           end
       end if
       line input #2, a$

       valid = 0
       llen= len(a$)
       if llen <3 then [cont]
       valid = 1
       for j = 1 to llen
           c$=mid$(a$, j, 1)
           if not (instr("abcdefghijklmnopqrstuvwxyz", c$)) then valid = 0 : exit for
       next
       if valid then
           i=i+1
           dict$(i)=a$
       end if
[cont]
   wend
   close #2

   print "Read ";i;" words"
   if i <>nWords then
       print "ERROR: should be "; nWords
       end
   end if

   t1=time$("ms")
   print "time taken "; t1-t0;" ms"
return

[checkWords]
   print "Cheking words..."
   for i = 1 to 10
       print i, dict$(i)
   next
   print ,"..."
   for i = nWords-10 to nWords
       print i, dict$(i)
   next
return

[mkDirArray]
   dim dx(7), dy(7)
   'clockwise, starting East
   dx(0) = 1:  dy(0) = 0
   dx(1) = 1:  dy(1) = 1
   dx(2) = 0:  dy(2) = 1
   dx(3) = -1: dy(3) = 1
   dx(4) = -1: dy(4) = 0
   dx(5) = -1: dy(5) = -1
   dx(6) = 0:  dy(6) = -1
   dx(7) = 1:  dy(7) = -1
return

[setBoard]
   for i = 1 to 4
       w$=word$(board$, i)
       for j = 1 to 4
           c$(i,j) = lower$(mid$(w$,j,1))    'cause dict is in lowercase
           if c$(i,j) ="" then c$(i,j) =" "
       next
   next
return

[printBoard]
   print "-------"
   for i = 1 to 4
       for j = 1 to 4
           print upper$(c$(i,j)); " " ;
       next
       print
   next
   print "-------"
return

[findWord]
   'found: -1 not found, 0 starts with, md found at md
   'values are at 1..nWords
   lo = 1
   hi = nWords
   found=-1
   while hi-lo>=0
       md=int((hi+lo)/2)
       'print lo, hi, dict$(lo), dict$(md), dict$(hi)
       if dict$(md)=w$ then found=md: exit while
       if w$<dict$(md) then
           hi=md-1
       else
           lo=md+1
       end if
   wend
   'md is exact place or "lo" place new word to be inserted
   'so
   if found < 0 then
       if lo <= nWords then
           if instr(dict$(lo),w$ )=1  then
               found = 0
           end if
       end if
   end if

   ' print "Finding ";w$
   ' select case found
   ' case -1
       ' print  "not found"
   ' case 0
       ' print "starts with"
   ' case else
       ' print "found"
   ' end select

return


[bplus]

'needs standart unixdict file

So "standart" unixdict.txt is with CR + LF? well then here is that (see attached, why is it smaller after compression??)
The file word does go allot faster too, don't have to split out the words from one line load.

tsh73 does seem faster but the list contains duplicates and is not sorted. Now to study his checking method to avoid repeating a cell in a word.

Attachments:

unixdictcrlf.zip (77.58 KB)

[bplus]

OK tsh73, this non recursive method is faster!

I sorted the found words and eliminated the duplicates to compare lists:
'Boggle backtracking    mod b+ 2022-05-21
'tsh73 May 2022
'needs standart unixdict file
'valid words   24819

global nWords
nWords = 24819
dim dict$(nWords), found$(3000)

gosub [readWords]
'gosub [checkWords]

gosub [mkDirArray]

'4 4-letter words
board$ = "IEAN LGIE TOPW JLDO" 'b+ example
'board$ = "CSXS TAYE"            'dkl example
'Take these 2 rows of 4. One can make the following words by using the adjacent letter in any available direction.
'CAT, CATS, CAST, TAX. SAY, YES, SEX, TAY, AYE, AXE, AXES, SAT, STAY.

brdSize=4
dim c$(brdSize,brdSize)

gosub [setBoard]
gosub [printBoard]

maxPath=brdSize*brdSize
dim path(maxPath), Xs(maxPath), Ys(maxPath)

for startY=1 to brdSize
   for startX=1 to brdSize
   'search for words from this

[init]
   cur = 1
   curX = startX:curY=startY
   Xs(cur)=curX:Ys(cur)=curY
   used$=" ";curX;curY
   w$ = c$(curY, curX)    'row col
   'print "start at ";curX;" ";curY;" ";w$

while 1
[step]
   dir = 0
   path(cur)=dir
[chkDir]
   x=curX+dx(dir)
   y=curY+dy(dir)
   if not(x>0 and x<=brdSize and y>0 and y<=brdSize) goto [noGood]
   'some checks to prevent looping
   if instr(used$,"";x;y) then goto [noGood] 'not in dict
   'new word
   w$=left$(w$, cur)+c$(y, x)    'row col
   'is in dictionary
   gosub [findWord]
   if found <0 then goto [noGood] 'not in dict
   if found >0 then
       'print "Found: "; w$
       q = q+1
       found$(q) = w$
   end if
   curX=x: curY=y
   used$=used$;" ";curX;curY
   cur=cur+1
   Xs(cur)=curX:Ys(cur)=curY
   goto [step]
[noGood]
   'try another direction
   if path(cur) <7 then
       dir=path(cur)+1
       path(cur)=dir
       goto [chkDir]
   else
       'go back
       if cur<=1 then 'all paths exausted
           exit while
       else
           'print ,"backtrack"
           cur = cur-1
           used$=left$(used$,cur*3)
           curX=Xs(cur):curY=Ys(cur)
           goto [noGood]
       end if
   end if

wend

   next startX
next startY

'print "-- OVER --"
'a$=input$(1)
sort found$(), 1, q  ' sort then remove dups
lastFound$ = ""
for i = 1 to q
   if found$(i) <> lastFound$ then count = count + 1: print found$(i),
   if count mod 8 = 0 then print
   lastFound$ = found$(i)
next
end

[readWords]
   fname$ = "unixdictcrlf.txt"
   t0=time$("ms")
   open fname$ for input as #2
   i=0
   while not(eof(#2))
       if i >nWords then
           print "ERROR: lines left but already read "; nWords;" words"
           close #2
           end
       end if
       line input #2, a$

       valid = 0
       llen= len(a$)
       if llen <3 then [cont]
       valid = 1
       for j = 1 to llen
           c$=mid$(a$, j, 1)
           if not (instr("abcdefghijklmnopqrstuvwxyz", c$)) then valid = 0 : exit for
       next
       if valid then
           i=i+1
           dict$(i)=a$
       end if
[cont]
   wend
   close #2

   print "Read ";i;" words"
   if i <>nWords then
       print "ERROR: should be "; nWords
       end
   end if

   t1=time$("ms")
   print "time taken "; t1-t0;" ms"
return

[checkWords]
   print "Cheking words..."
   for i = 1 to 10
       print i, dict$(i)
   next
   print ,"..."
   for i = nWords-10 to nWords
       print i, dict$(i)
   next
return

[mkDirArray]
   dim dx(7), dy(7)
   'clockwise, starting East
   dx(0) = 1:  dy(0) = 0
   dx(1) = 1:  dy(1) = 1
   dx(2) = 0:  dy(2) = 1
   dx(3) = -1: dy(3) = 1
   dx(4) = -1: dy(4) = 0
   dx(5) = -1: dy(5) = -1
   dx(6) = 0:  dy(6) = -1
   dx(7) = 1:  dy(7) = -1
return

[setBoard]
   for i = 1 to 4
       w$=word$(board$, i)
       for j = 1 to 4
           c$(i,j) = lower$(mid$(w$,j,1))    'cause dict is in lowercase
           if c$(i,j) ="" then c$(i,j) =" "
       next
   next
return

[printBoard]
   print "-------"
   for i = 1 to 4
       for j = 1 to 4
           print upper$(c$(i,j)); " " ;
       next
       print
   next
   print "-------"
return

[findWord]
   'found: -1 not found, 0 starts with, md found at md
   'values are at 1..nWords
   lo = 1
   hi = nWords
   found=-1
   while hi-lo>=0
       md=int((hi+lo)/2)
       'print lo, hi, dict$(lo), dict$(md), dict$(hi)
       if dict$(md)=w$ then found=md: exit while
       if w$<dict$(md) then
           hi=md-1
       else
           lo=md+1
       end if
   wend
   'md is exact place or "lo" place new word to be inserted
   'so
   if found < 0 then
       if lo <= nWords then
           if instr(dict$(lo),w$ )=1  then
               found = 0
           end if
       end if
   end if

   ' print "Finding ";w$
   ' select case found
   ' case -1
       ' print  "not found"
   ' case 0
       ' print "starts with"
   ' case else
       ' print "found"
   ' end select

return


[tsh73]

So "standart" unixdict.txt is with CR + LF?

LOL
actually I used file from one of previous DKL games.
And it is CR LF delimited, it just have no sence not to be then used in Windows
actually I made filtered version (stuff that in posted program does on each load) and it loads under 1 second.

For a record
Indeed unixdict.txt is LF delimited
that could be easily changed by loading to LB text editor (or text window)/resaving
like this
fname$ = "unixdict.txt"
fname2$ = "unixdictCRLF.txt"
open fname$ for input as #1
input #1, a$
close #1
print len(a$)

if len(a$)>100 then
print "Indeed ";fname$;" is LF-delimited"
else
goto [q]
end if

open "dummy" for text as #txt
'load file
open fname$ for input as #1
#txt "!contents #1";
close #1

'save file
#txt "!contents? cont$";
open fname2$ for output as #2
print #2, cont$
close #2

close #txt
print "File resaved as ";fname2$

[q]
input "press Enter to quit"; dummy$
end



Also there is short article from author explayning how and why unixdict came to being
wiki.puzzlers.org/dokuwiki/doku.php?id=solving:wordlists:about:mcilroy

[bplus]

Ha! to make the LF delimited unxidict.txt file CR+LF delimited, I just loaded the file into QB64 Editor and saved it under unixdictcrlf.txt file, no coding needed.

BTW it does not compress to a smaller file, but this forum sees and reports it as smaller for some reason (78.88 KB first file was only LF delimited, 2nd file 77.88 KB with delimited CR + LF file)?

Screen shot shows expected size increase with extra CR's:

Attachments:

[bplus]

Aha! Building words from the board would take a very, very long time with tsh73 non recursive method except for the way he looks up words in the dictionary.

' check out the 2nd part of this code, a sub I made from his GoSub FindWord:
Function Found (w$)
   lo = 1
   hi = topWord
   Fnd = -1 ' assume not found
   While hi - lo >= 0
       md = Int((hi + lo) / 2)
       If dWords$(md) = w$ Then Fnd = md: Exit While
       If w$ < dWords$(md) Then
           hi = md - 1
       Else
           lo = md + 1
       End If
   Wend

   ' this makes a huge difference in time savings
   If Fnd < 0 Then
       If lo <= topWord Then
           If InStr(dWords$(lo), w$) = 1 Then ' we didn't find the word but w$ is the potential base of a word!!!
               Fnd = 0 ' !!!!!!!!!!!!! signal that we aren't on the wrong track here !!!!!!!!!!!!
           End If
       End If
   End If
   Found = Fnd
End Function

If the word is found, yeah OK return the word position in the array of dictionary words but if the word is not found, will the word be the base of a potential word starting with same amount of letters, ie If InStr(dWords$(lo), w$) = 1 Then ' yes w$ is the first letters of a real word, so we are on the right track for a possible word, so flag it as 0, OK on track for a word, otherwise flag -1 = lose this combo of letters now, it leads nowhere!

This one bit more of information from the dictionary check saves a huge amount of time. ie if no word starts with bb, drop that path and go back and try another starting set of letters for a word, that saves checking bba, bbb, bbc, ... then bbaa, bbab,... because no word starts with bb!

That is what makes the difference between a very slow time and a very fast time.

My middle time was from going through every word in dictionary and seeing if the words were buildable from the given board. I did skip through letters not in board but only by incrementing by 1 the dictionary index.

[tsh73]

You can substantially speed up your
sub AIwords
with checking if wd$ indeed could be constructed from letters$
so
   for dp = 1 to topWord
       scan
       wd$ = dWords$(dp)
       allLetters=1
       for i = 1 to len(wd$)
           if instr(letters$, mid$(wd$,i,1))=0 then allLetters=0: exit for
       next
       if allLetters=0 then [nxtWord]
       If WordBuildOK(wd$) Then
           print wd$,
           wCount = wCount + 1
           if wCount mod 8 = 0 then print
       End If
[nxtWord]
   next

instead of
'now letters of board are in alpha order
   dp = 1 'place in dict
   For l = 1 To Len(letters$) ' advance place in list$ by one until the word > letter
       wd$ = dWords$(dp)
       While Asc(wd$) < Asc(mid$(letters$, l, 1))
           scan
           dp = dp + 1
           If dp > topWord Then exit sub
           wd$ = dWords$(dp)
       Wend
       'now start testing words
       While Asc(wd$) = Asc(mid$(letters$, l, 1))
           scan
           If WordBuildOK(wd$) Then
               print wd$,
               wCount = wCount + 1
               if wCount mod 8 = 0 then print
           End If
           dp = dp + 1
           If dp > topWord Then exit sub
           wd$ = dWords$(dp)
       Wend
   Next


[bplus]

Dang tsh73, building words from board with your non recursive method is light years faster even if I add the check allLetters test!

Here is a snap of a pretty typical comparison, the 2nd list is made with the non recursive that includes a sort and a redundant word removal, that time is amazing!

[dkl]

Sorry, I didn't see all the new posts. plenty for me to study and learn from. Thank you!