QB64.org Forum

Active Forums => Programs => Topic started by: bplus on January 13, 2022, 11:46:33 am

Title: Boggle play against AI - WIP
Post by: bplus on January 13, 2022, 11:46:33 am

https://en.wikipedia.org/wiki/Boggle

The AI is going to be handicapped starting with only 1 point words (3 or 4 letters words from Scrabble Dictionary that don't use Q (that is 2 points)) and maybe a shorter time limit too.

Just got started last night from trying to figure out Dimster's "Babble" Game, I thought he might mean Boggle?

Any way got a board working:

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Boggle 1" ' b+ start 2022-01-12
3. ' Scabble Word List and Dictionary
4. ' ref dictionary: https://boardgames.stackexchange.com/questions/38366/latest-collins-scrabble-words-list-in-text-file
5. ' Die configurations
6. ' https://boardgames.stackexchange.com/questions/29264/boggle-what-is-the-dice-configuration-for-boggle-in-various-languages
7. ' Thank you!
8.  
9. Randomize Timer
10. Dim Shared Board$(3, 3)
11. Dim Shared As Long f48, f30, dx(7), dy(7)
12. Screen _NewImage(800, 600, 32)
13. _ScreenMove 200, 100
14. _PrintMode _KeepBackground
15. Do
16.     Cls
17.     NewBoard
18.     ' display timer and allow input of words from user for 3 minutes
19.     ' meanwhile AI will calc all the 1 point words it can from board
20.  
21.     Sleep
22. Loop
23.  
24. Sub NewBoard
25.     Static BeenHere, Di$(), Numbers()
26.     Dim As Long i, r, c, row, col
27.     If BeenHere = 0 Then 'load and initialize
28.         f48 = _LoadFont("Arial.ttf", 48, "MONOSPACE")
29.         f30 = _LoadFont("Arial.ttf", 30, "MONOSPACE")
30.         If f48 <= 0 Then Print "Sub NewBoard: Font did not load, goodbye.": End
31.         dx(0) = -1: dy(0) = -1 ' this is for AI to find words
32.         dx(1) = 0: dy(1) = -1
33.         dx(2) = 1: dy(2) = -1
34.         dx(3) = -1: dy(3) = 0
35.         dx(4) = 1: dy(4) = 0
36.         dx(5) = -1: dy(5) = 1
37.         dx(6) = 0: dy(6) = 1
38.         dx(7) = 1: dy(7) = 1
39.         Dim Di$(0 To 15) ' this for 16 di, 6 letters per
40.         Di$(1) = "RIFOBX"
41.         Di$(2) = "IFEHEY"
42.         Di$(3) = "DENOWS"
43.         Di$(4) = "UTOKND"
44.         Di$(5) = "HMSRAO"
45.         Di$(6) = "LUPETS"
46.         Di$(7) = "ACITOA"
47.         Di$(8) = "YLGKUE"
48.         Di$(9) = "QBMJOA"
49.         Di$(10) = "EHISPN"
50.         Di$(11) = "VETIGN"
51.         Di$(12) = "BALIYT"
52.         Di$(13) = "EZAVND"
53.         Di$(14) = "RALESC"
54.         Di$(15) = "UWILRG"
55.         Di$(0) = "PACEMD"
56.         Dim Numbers(0 To 15) ' for shuffling die order
57.         For i = 0 To 15
58.             Numbers(i) = i
59.         Next
60.         BeenHere = -1
61.     End If
62.     For i = 15 To 1 Step -1 'shuffle die
63.         Swap Numbers(i), Numbers(Int(Rnd * (i + 1)))
64.     Next
65.     'For i = 1 To 16: Print Numbers(i);: Next: Print   ' check the shuffle
66.     For i = 0 To 15 'choosing random face of die = 1 Letter
67.         Index2ColRow i, c, r
68.         Board$(c, r) = Mid$(Di$(Numbers(i)), Int(Rnd * 6) + 1, 1)
69.     Next
70.     _Font f48
71.     For row = 0 To 3 '  display the board
72.         For col = 0 To 3
73.             Line ((col + 1) * 60 - 5, (row + 1) * 60 - 5)-Step(54, 54), &HFF2020FF, BF 'face color or die
74.             If Board$(col, row) = "Q" Then 'If face has a Q it is supposed to be "Qu"
75.                 _Font f30
76.                 Color &HFF661111 'shade
77.                 _PrintString ((col + 1) * 60 - 4, (row + 1) * 60 + 11), "Q"
78.                 _PrintString ((col + 1) * 60 + 24, (row + 1) * 60 + 11), "U"
79.                 Color &HFFBBBBBB 'letter
80.                 _PrintString ((col + 1) * 60 - 7, (row + 1) * 60 + 9), "Q"
81.                 _PrintString ((col + 1) * 60 + 22, (row + 1) * 60 + 9), "U"
82.                 _Font f48
83.             Else
84.                 Color &HFF661111 'shade
85.                 _PrintString ((col + 1) * 60 + 2, (row + 1) * 60 + 2), Board$(col, row)
86.                 Color &HFFBBBBBB 'letter
87.                 _PrintString ((col + 1) * 60, (row + 1) * 60), Board$(col, row)
88.             End If
89.         Next
90.     Next
91.     _Font 16
92. End Sub
93.  
94. Function ColRow2Index& (row As Long, col As Long) ' convert a board letter to index (not needed yet?)
95.     ColRow2Index& = row * 4 + col
96. End Function
97. Sub Index2ColRow (indexIn As Long, rowOut As Long, colOut As Long) 'convert die index to board col, row
98.     colOut = indexIn Mod 4: rowOut = indexIn \ 4
99. End Sub
100.  

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 13, 2022, 06:14:12 pm

Dang the Collins Dictionary is too big to load, QB64 keeps bugging out, no error message, just quits.
279,496 words

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 14, 2022, 08:15:13 am

The amount of words I could store and not in terrible time was about 260,000 before QB64 (on my Windows 10 laptop system) bugged out without so much as error message, at least it didn't crash the whole system. Tried Open For Input and Open For Binary, one gulp method. OK it's 2.96 MB according to properties Window.

I have already worked a fairly practical workaround by limiting the words by number of letters, another maybe not to load the dictionary at all and just search for words in the hard disk by turning it into a Random access file or something.

But I wonder if there is another way to get the dictionary loaded into program whole. Is about 1 MB the limit for variable length string memory?

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 14, 2022, 08:42:07 am

Oh boy! Just got the trickiest Function working :)

It's the one that confirms a word can or can not be legally built from a given board. Interestingly it uses a recursive function to seek out the rest of the word from a given letter location once the first letter has been matched from the game board. I am a bit shocked, it's like magic :)

 (Of course the shock would have been worse had it worked right off.)

Update: OK same logic bug happened in the recursive helper function, more subtle, I think I have them exterminated now.

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 14, 2022, 12:37:46 pm

That AI looks like it will need more handicap, here is what it came up with in 30 secs. Looks like that was enough time to test the whole dang OnePointList$(). I've still got to work out dealing with special case Q amongst checking player redundant words, scoring and handicapping.

The first test of AI play:
  [ This attachment cannot be displayed inline in 'Print Page' view ]  

WIP:

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Boggle 1" ' b+ start 2022-01-12
3. ' Scabble Word List and Dictionary
4. ' ref dictionary: https://boardgames.stackexchange.com/questions/38366/latest-collins-scrabble-words-list-in-text-file
5. ' Die configurations
6. ' https://boardgames.stackexchange.com/questions/29264/boggle-what-is-the-dice-configuration-for-boggle-in-various-languages
7. ' Thank you!
8.  
9. ' 2022-01-14 status have the board display separated out from New Board and Game initialization
10. ' have timer system and display working next to board display
11. ' have player input system working
12. '   1. check word in dictionary working
13. '   2. check that word can legally be built from board is funky! sometimes works sometimes not 50/50 for legit builds yuck
14. '     How to debug? Todays task is get this abolutely critical function working so the AI would be fairly easy to do.
15. ' Oh I had to modify the Collins Word list to get a size that would fit into a variable length string array, 279496 words
16. ' kept crashing QB64 without error messages when reached about 260,000 words so now I have a list for words with lengths of
17. ' between 3 and 10, still 199,651 words!
18. ' 2202-01-14 Hurray! Function wordBuildOK& is fixed, a very simple logic bug. I continued to check for builds of word after
19. ' I got confirmation one of the builds was possible. It kept checking if there was more than one place the first letter of word
20. ' appeared. The function is crucial for AI testing if words are buildable. I can get started on that today now that bug is
21. ' fixed. Man! I had this fixed almost immediately, I had to exit the Function when the recursive function findCell& called from
22. ' it found a positive result. AI is working.
23.  
24. Randomize Timer
25. Const TimeLimit = 180 ' actual game time is 3 minutes = 180 secs
26. Dim Shared Board$(3, 3), WordList$(1 To 199651), OnePointList$(1 To 6955)
27. Dim Shared As Long f48, f30, dx(7), dy(7)
28. Dim Shared As Double BoggleTime, elapsed
29. Dim w$, k$, player$, AI$
30. Dim As Long printLine
31. Screen _NewImage(800, 600, 32)
32. _ScreenMove 200, 100
33. _PrintMode _KeepBackground
34. Do
35.     NewBoard
36.     DisplayBoard
37.     elapsed = 0
38.     'Do ' display timer and allow input of words from user for 3 minutes
39.     printLine = 20
40.     player$ = "": w$ = ""
41.     While elapsed < TimeLimit ' do stuff   <<<<<<<<<<<<<<<<<<<<<< off while debug wordBuildOK
42.         Cls
43.         DisplayBoard
44.         elapsed = Timer(.01) - BoggleTime
45.         If elapsed < 0 Then elapsed = 24 * 60 * 60 + Timer(.01) - BoggleTime ' midnight problem add aday of seconds to timer and subtr boogle
46.         _Font f48
47.         Line (300, 240)-Step(180, 60), &HFF000000, BF ' blackout last time
48.         Color &HFFFFFF00
49.         _PrintString (300, 240), _Trim$(Str$(TimeLimit - Int(elapsed)))
50.  
51.         _Font 16
52.         Color _RGB32(200, 200, 255)
53.         k$ = UCase$(InKey$)
54.         If Len(k$) Then 'handle 1 and 2 char key presses, maybe replace with _keyhit later
55.             Select Case Len(k$)
56.                 Case 1
57.                     Select Case Asc(k$)
58.                         Case 3 'Ctrl + C   another way to clear?
59.                             w$ = ""
60.                         Case 8 ' backspace          more to do
61.                             If Len(w$) Then w$ = Left$(w$, Len(w$) - 1)
62.                         Case 13
63.                             If wordBuildOK&(w$) Then
64.                                 If Find&(WordList$(), w$) Then ' check words before add to player$
65.                                     If player$ = "" Then player$ = w$ Else player$ = player$ + " " + w$
66.                                 End If
67.                             End If
68.                             w$ = ""
69.                         Case 27 'esc
70.                             w$ = "" ': exit ?
71.                         Case Else
72.                             If 63 < Asc(k$) And Asc(k$) < 91 Then w$ = w$ + k$
73.                     End Select
74.             End Select
75.         End If
76.         Locate printLine, 1: Print w$
77.         Locate printLine + 2, 1: Print player$
78.  
79.         _Display
80.         _Limit 60
81.     Wend
82.     _AutoDisplay
83.     _PrintString (400, 240), "Times up!"
84.  
85.     'lets see what the AI comes up with
86.     AI$ = AIwords$(30) ' try 30 secs for starters
87.     Locate printLine + 6, 1
88.     Print "AI: "; AI$
89.  
90.     Sleep
91. Loop
92.  
93. Sub NewBoard
94.     Static BeenHere, Di$(), Numbers()
95.     Dim As Long i, r, c
96.  
97.     If BeenHere = 0 Then 'load and initialize all the one time stuff
98.         ' load fonts
99.         f48 = _LoadFont("Arial.ttf", 48, "MONOSPACE")
100.         f30 = _LoadFont("Arial.ttf", 30, "MONOSPACE")
101.         If f48 <= 0 Then Print "Sub NewBoard: Font did not load, goodbye.": End
102.  
103.         'load abrev Dictionary ======================================== comment out while debug wordBuildOK
104.         Open "3 to 10 Letter Words.txt" For Input As #1
105.         Print "Loading Dictionary..."
106.         While Not EOF(1)
107.             i = i + 1
108.             Input #1, WordList$(i)
109.             'Cls: Locate 2, 1: Print i
110.         Wend
111.         Close #1
112.  
113.         ' test load of file, find last 10 items
114.         'For i = 199651 - 10 To 199651
115.         '    Print WordList$(i)
116.         'Next
117.         'Sleep    OK loading
118.  
119.         Open "Boggle 1 Point Words.txt" For Input As #1
120.         Print "Loading Boggle 1 Point Words.txt for AI..."
121.         i = 0
122.         While Not EOF(1)
123.             i = i + 1
124.             Input #1, OnePointList$(i)
125.         Wend
126.         Close #1
127.  
128.         ' load dx(), dy() for testing the legality of words built from board
129.         dx(0) = -1: dy(0) = -1 ' this is for AI to find words
130.         dx(1) = 0: dy(1) = -1
131.         dx(2) = 1: dy(2) = -1
132.         dx(3) = -1: dy(3) = 0
133.         dx(4) = 1: dy(4) = 0
134.         dx(5) = -1: dy(5) = 1
135.         dx(6) = 0: dy(6) = 1
136.         dx(7) = 1: dy(7) = 1
137.  
138.         ' These are the 16 Dice with 6 Faces of a Letter need for Boggle
139.         Dim Di$(0 To 15) ' this for 16 di, 6 letters per
140.         Di$(1) = "RIFOBX"
141.         Di$(2) = "IFEHEY"
142.         Di$(3) = "DENOWS"
143.         Di$(4) = "UTOKND"
144.         Di$(5) = "HMSRAO"
145.         Di$(6) = "LUPETS"
146.         Di$(7) = "ACITOA"
147.         Di$(8) = "YLGKUE"
148.         Di$(9) = "QBMJOA"
149.         Di$(10) = "EHISPN"
150.         Di$(11) = "VETIGN"
151.         Di$(12) = "BALIYT"
152.         Di$(13) = "EZAVND"
153.         Di$(14) = "RALESC"
154.         Di$(15) = "UWILRG"
155.         Di$(0) = "PACEMD"
156.  
157.         Dim Numbers(0 To 15) ' load numbers for shuffling die order
158.         For i = 0 To 15
159.             Numbers(i) = i
160.         Next
161.         BeenHere = -1
162.     End If
163.  
164.     'now get the game going
165.     For i = 15 To 1 Step -1 'shuffle die
166.         Swap Numbers(i), Numbers(Int(Rnd * (i + 1)))
167.     Next
168.     'For i = 1 To 16: Print Numbers(i);: Next: Print   ' check the shuffle
169.     For i = 0 To 15 'choosing random face of die = 1 Letter
170.         Index2ColRow i, c, r
171.         Board$(c, r) = Mid$(Di$(Numbers(i)), Int(Rnd * 6) + 1, 1)
172.     Next
173.     ' now set timer + 180
174.     BoggleTime = Timer(.01)
175.     _Font 16
176. End Sub
177.  
178. Sub DisplayBoard
179.     Dim row, col
180.     _Font f48
181.     For row = 0 To 3 '  display the board
182.         For col = 0 To 3
183.             Line ((col + 1) * 60 - 5, (row + 1) * 60 - 5)-Step(54, 54), &HFF2020FF, BF 'face color or die
184.             If Board$(col, row) = "Q" Then 'If face has a Q it is supposed to be "Qu"
185.                 _Font f30
186.                 Color &HFF661111 'shade
187.                 _PrintString ((col + 1) * 60 - 4, (row + 1) * 60 + 11), "Q"
188.                 _PrintString ((col + 1) * 60 + 24, (row + 1) * 60 + 11), "U"
189.                 Color &HFFBBBBBB 'letter
190.                 _PrintString ((col + 1) * 60 - 7, (row + 1) * 60 + 9), "Q"
191.                 _PrintString ((col + 1) * 60 + 22, (row + 1) * 60 + 9), "U"
192.                 _Font f48
193.             Else
194.                 Color &HFF661111 'shade
195.                 _PrintString ((col + 1) * 60 + 2, (row + 1) * 60 + 2), Board$(col, row)
196.                 Color &HFFBBBBBB 'letter
197.                 _PrintString ((col + 1) * 60, (row + 1) * 60), Board$(col, row)
198.             End If
199.         Next
200.     Next
201. End Sub
202.  
203. Function ColRow2Index& (row As Long, col As Long) ' convert a board letter to index (not needed yet?)
204.     ColRow2Index& = row * 4 + col
205. End Function
206. Sub Index2ColRow (indexIn As Long, rowOut As Long, colOut As Long) 'convert die index to board col, row
207.     colOut = indexIn Mod 4: rowOut = indexIn \ 4
208. End Sub
209.  
210. Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
211.     Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
212.     curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
213.     dpos = InStr(curpos, SplitMeString, delim)
214.     Do Until dpos = 0
215.         loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
216.         arrpos = arrpos + 1
217.         If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
218.         curpos = dpos + LD
219.         dpos = InStr(curpos, SplitMeString, delim)
220.     Loop
221.     loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
222.     ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
223. End Sub
224.  
225. Function Find& (SortedArr$(), x$) ' if I am using this only to find words in dictionary, I can mod to optimize
226.     Dim As Long low, hi, test
227.     low = LBound(SortedArr$): hi = UBound(SortedArr$)
228.     While low <= hi
229.         test = Int((low + hi) / 2)
230.         If SortedArr$(test) = x$ Then
231.             Find& = test: Exit Function
232.         Else
233.             If SortedArr$(test) < x$ Then low = test + 1 Else hi = test - 1
234.         End If
235.     Wend
236. End Function
237.  
238. Function wordBuildOK& (w$) ' this function checks to see that the was constructed (or is constructable with the given board).
239.     Dim As Long r, c, test
240.     Dim copy$(-1 To 4, -1 To 4), first$
241.     For r = 0 To 3
242.         For c = 0 To 3
243.             copy$(c, r) = Board$(c, r)
244.         Next
245.     Next
246.  
247.     first$ = Mid$(w$, 1, 1)
248.     For r = 0 To 3
249.         For c = 0 To 3
250.             If copy$(c, r) = first$ Then 'cell letter matches first letter in word
251.                 test = findCell&(c, r, w$, 2, copy$())
252.                 If test Then wordBuildOK& = -1: Exit Function ' ah ha! maybe it keeps trying when we are supposed to be done, fix?
253.             End If
254.         Next
255.     Next
256. End Function
257.  
258. 'recursively called starting from wordBuildOK&
259. Function findCell& (startX As Long, startY As Long, word$, index As Long, Arr$()) ' want to setup recursive searcher
260.     Dim As Long d, x, y, i, r, c, test
261.     Dim w$
262.     'make own set of variables for this function  (attempt to debug but did not fix anything)
263.     Dim a$(-1 To 4, -1 To 4)
264.     For r = 0 To 3
265.         For c = 0 To 3
266.             a$(c, r) = Arr$(c, r)
267.         Next
268.     Next
269.     i = index: w$ = word$: y = startY: x = startX
270.     If i > Len(w$) Then findCell = -1: Exit Function
271.     a$(x, y) = "" 'so wont be used again
272.     For d = 0 To 7
273.         If a$(x + dx(d), y + dy(d)) = Mid$(w$, i, 1) Then
274.             test = findCell&(x + dx(d), y + dy(d), w$, i + 1, a$())
275.             If test Then findCell& = -1: Exit Function
276.         End If
277.     Next
278. End Function
279.  
280. Function AIwords$ (timeLimit As Long) 'returns a space delimiter string of 1 point words that can be constructed from board in limited time
281.     Dim As Double startTime, checkTime
282.     Dim As Long i, r, c, OK, dp, l, ub
283.     Dim l$, letters$, b$
284.     startTime = Timer(.01)
285.     ub = UBound(OnePointList$)
286.     ' get a non redundant list of letters from board
287.     For r = 0 To 3
288.         For c = 0 To 3
289.             l$ = Board$(c, r)
290.             If (r = 0) And (c = 0) Then
291.                 letters$ = l$
292.             Else
293.                 If InStr(letters$, l$) <= 0 Then '  insrt letter
294.                     OK = 0
295.                     For i = 1 To Len(letters$)
296.                         If Asc(l$) < Asc(letters$, i) Then ' insert spotted
297.                             If i = 1 Then
298.                                 letters$ = l$ + letters$: OK = -1: Exit For
299.                             Else
300.                                 letters$ = Mid$(letters$, 1, i - 1) + l$ + Mid$(letters$, i)
301.                                 OK = -1: Exit For
302.                             End If
303.                         End If
304.                     Next
305.                     If OK = 0 Then letters$ = letters$ + l$
306.                 End If
307.             End If
308.         Next
309.     Next
310.     'check if this is OK so far  OK finally!  This is 3rd time I needed to exit when found
311.     ' AIwords$ = letters$
312.     'now letters of board are in alpha order
313.     dp = 1 'place in dict
314.     For l = 1 To Len(letters$) ' advance place in list$ by one until the word > letter
315.         While Asc(OnePointList$(dp), 1) < Asc(letters$, l)
316.             dp = dp + 1
317.             If dp > ub Then GoTo fini
318.             If Timer(.01) - startTime < 0 Then checkTime = Timer(.01) + 24 * 60 * 60 Else checkTime = Timer(.01)
319.             If checkTime - startTime > timeLimit Then GoTo fini
320.         Wend
321.         'now start testing words
322.         While Asc(OnePointList$(dp), 1) = Asc(letters$, l)
323.             If wordBuildOK&(OnePointList$(dp)) Then
324.                 If b$ = "" Then b$ = OnePointList$(dp) Else b$ = b$ + " " + OnePointList$(dp)
325.             End If
326.             dp = dp + 1
327.             If dp > ub Then GoTo fini
328.             If Timer(.01) - startTime < 0 Then checkTime = Timer(.01) + 24 * 60 * 60 Else checkTime = Timer(.01)
329.             If checkTime - startTime > timeLimit Then GoTo fini
330.         Wend
331.     Next
332.  
333.     fini:
334.     AIwords$ = b$
335. End Function

Title: Re: Boggle play against AI - WIP
Post by: Statsman1 on January 14, 2022, 01:05:31 pm

@bplus - Dude, you are on FIRE.  Fantastic stuff so quickly!

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 14, 2022, 03:15:20 pm

Quote from: Statsman1 on January 14, 2022, 01:05:31 pm

@bplus - Dude, you are on FIRE.  Fantastic stuff so quickly!

Gotta say, @Statsman1 you are helping fan the fire, thanks for your enthusiastic interest.

Title: Re: Boggle play against AI - WIP
Post by: Statsman1 on January 14, 2022, 03:39:49 pm

Quote from: bplus on January 14, 2022, 03:15:20 pm

Gotta say, @Statsman1 you are helping fan the fire, thanks for your enthusiastic interest.

I love word games, so this is just great stuff.  I really appreciate that you would do all of this.

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 14, 2022, 03:51:41 pm

Quote from: Statsman1 on January 14, 2022, 03:39:49 pm

I love word games, so this is just great stuff.  I really appreciate that you would do all of this.

Ah word games, checkout @Qwerkey plus crosswords and another about snaking word around a grid maybe like Boggle? It was from a newspaper puzzle and it was awhile ago and I may have author confused with someone else?

Bplus also did WordSearch had a pretty good package for Rosetta Code Challenge but interacting with Richard Frost and his work of getting all the elements of periodic table to fit in a grid really improved my game. I think I got to point of building word searches for your own list of items.

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 15, 2022, 12:13:53 pm

OK I have basic game roughed out. Now I am handling the Q(u) Letter better still needs more testing. I need a qu? word that is 3 letters with u, to see if you type 2 letters the first a q and enter q? the word will be added to your list. BTW the 1 Point List that the AI uses doesn't have any Q words because originally I thought Q words were 2 points. No Q words contain the hidden letter U which could potentially make the word a letter longer that the one you type and points are awarded by number of letters. All the goofiness in coding could have been simplified by having 1 die with Q and maybe a couple extra u's and other vowels. That may be a mod down the line from here 17 dice, the 17th with aeiouu. This game is boring if have a whole bunch of constanents (sp? for not-a-vowel).

Now there is a Sleep between seeing your list and AI's before matching words are removed from both lists and final score calculated and shown. Yours will likely be 0 unless you come up with 5 or more letter words but at lest all your 3-4 letter word will negate the AI's.

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Boggle 1" ' b+ start 2022-01-12
3. ' Scabble Word List and Dictionary
4. ' ref dictionary: https://boardgames.stackexchange.com/questions/38366/latest-collins-scrabble-words-list-in-text-file
5. ' Die configurations
6. ' https://boardgames.stackexchange.com/questions/29264/boggle-what-is-the-dice-configuration-for-boggle-in-various-languages
7. ' Thank you!
8.  
9. ' 2022-01-14 status have the board display separated out from New Board and Game initialization
10. ' have timer system and display working next to board display
11. ' have player input system working
12. '   1. check word in dictionary working
13. '   2. check that word can legally be built from board is funky! sometimes works sometimes not 50/50 for legit builds yuck
14. '     How to debug? Todays task is get this abolutely critical function working so the AI would be fairly easy to do.
15. ' Oh I had to modify the Collins Word list to get a size that would fit into a variable length string array, 279496 words
16. ' kept crashing QB64 without error messages when reached about 260,000 words so now I have a list for words with lengths of
17. ' between 3 and 10, still 199,651 words!
18. ' 2202-01-14 Hurray! Function wordBuildOK& is fixed, a very simple logic bug. I continued to check for builds of word after
19. ' I got confirmation one of the builds was possible. It kept checking if there was more than one place the first letter of word
20. ' appeared. The function is crucial for AI testing if words are buildable. I can get started on that today now that bug is
21. ' fixed. Man! I had this fixed almost immediately, I had to exit the Function when the recursive function findCell& called from
22. ' it found a positive result.
23.  
24. ' 2022-01-15 qw$() function to handle the Q letter, function to handle scoring, main removes matching words on the 2 lists.
25. ' you should be able to type 2 letters with (qu) square and get a 3 letter word.
26.  
27. Randomize Timer
28. Const TimeLimit = 180 ' actual game time is 3 minutes = 180 secs
29. Dim Shared Board$(3, 3), WordList$(1 To 199651), OnePointList$(1 To 6955)
30. Dim Shared As Long f48, f30, dx(7), dy(7)
31. Dim Shared As Double BoggleTime, elapsed
32. Dim w$, k$, player$, AI$
33. Dim As Long printLine, pScore, aiScore, uba, ubp, i, j
34. Screen _NewImage(800, 600, 32)
35. _ScreenMove 200, 100
36. _PrintMode _KeepBackground
37. Do
38.     NewBoard
39.     DisplayBoard
40.     elapsed = 0
41.     'Do ' display timer and allow input of words from user for 3 minutes
42.     printLine = 20
43.     player$ = "": w$ = ""
44.     While elapsed < TimeLimit ' do stuff   <<<<<<<<<<<<<<<<<<<<<< off while debug wordBuildOK
45.         Cls
46.         DisplayBoard
47.         elapsed = Timer(.01) - BoggleTime
48.         If elapsed < 0 Then elapsed = 24 * 60 * 60 + Timer(.01) - BoggleTime ' midnight problem add aday of seconds to timer and subtr boogle
49.         _Font f48
50.         Line (300, 240)-Step(180, 60), &HFF000000, BF ' blackout last time
51.         Color &HFFFFFF00
52.         _PrintString (300, 240), _Trim$(Str$(TimeLimit - Int(elapsed)))
53.  
54.         _Font 16
55.         Color _RGB32(200, 200, 255)
56.         k$ = UCase$(InKey$)
57.         If Len(k$) Then 'handle 1 and 2 char key presses, maybe replace with _keyhit later
58.             Select Case Len(k$)
59.                 Case 1
60.                     Select Case Asc(k$)
61.                         Case 3 'Ctrl + C   another way to clear?
62.                             w$ = ""
63.                         Case 8 ' backspace          more to do
64.                             If Len(w$) Then w$ = Left$(w$, Len(w$) - 1)
65.                         Case 13
66.                             If wordBuildOK&(w$) Then
67.                                 If Find&(WordList$(), qw$(w$)) Then ' check words before add to player$
68.                                     If player$ = "" Then player$ = qw$(w$) Else player$ = player$ + " " + qw$(w$)
69.                                 End If
70.                             End If
71.                             w$ = ""
72.                         Case 27 'esc
73.                             w$ = "" ': exit ?
74.                         Case Else
75.                             If 63 < Asc(k$) And Asc(k$) < 91 Then w$ = w$ + k$
76.                     End Select
77.             End Select
78.         End If
79.         Locate printLine, 1: Print w$
80.         Locate printLine + 2, 1: Print player$
81.  
82.         _Display
83.         _Limit 60
84.     Wend
85.     _AutoDisplay
86.     _PrintString (400, 240), "Times up!"
87.  
88.     'lets see what the AI comes up with
89.     AI$ = AIwords$(.07) ' try 30 secs for starters, 5 still gets a complete list, try 1 sec  OK that doesn't quite finish
90.     Locate printLine + 6, 1: Print "AI: "; AI$
91.     Print
92.     Print "          zzz... Press any for the time of reconning,"
93.     Print "   matching words on 2 lists will be removed and the round scored."
94.     Sleep
95.     ' evalaute results (remove matching words in lists) and score
96.     Cls
97.     DisplayBoard
98.     _Font 16
99.     player$ = removeRepeats$(player$)
100.     ReDim p(1 To 1) As String
101.     Split player$, " ", p()
102.     ubp = UBound(p)
103.     ReDim a(1 To 1) As String
104.     Split AI$, " ", a()
105.     uba = UBound(a)
106.     For i = 1 To uba
107.         For j = 1 To ubp
108.             If a(i) = p(j) Then a(i) = "": p(j) = ""
109.         Next
110.     Next
111.     pScore = score&(p())
112.     aiScore = score&(a())
113.     AI$ = ""
114.     player$ = ""
115.     For i = 1 To uba
116.         If a(i) <> "" Then AI$ = AI$ + " " + a(i)
117.     Next
118.     For i = 1 To ubp
119.         If p(i) <> "" Then player$ = player$ + " " + p(i)
120.     Next
121.     Locate printLine + 1, 1: Print "Player:"; player$
122.     Print " Score:"; pScore
123.     Locate printLine + 6, 1: Print "AI:"; AI$
124.     Print " Score:"; aiScore
125.     Sleep
126. Loop
127.  
128. Sub NewBoard
129.     Static BeenHere, Di$(), Numbers()
130.     Dim As Long i, r, c
131.  
132.     If BeenHere = 0 Then 'load and initialize all the one time stuff
133.         ' load fonts
134.         f48 = _LoadFont("Arial.ttf", 48, "MONOSPACE")
135.         f30 = _LoadFont("Arial.ttf", 30, "MONOSPACE")
136.         If f48 <= 0 Then Print "Sub NewBoard: Font did not load, goodbye.": End
137.  
138.         'load abrev Dictionary ======================================== comment out while debug wordBuildOK
139.         Open "3 to 10 Letter Words.txt" For Input As #1
140.         Print "Loading Dictionary..."
141.         While Not EOF(1)
142.             i = i + 1
143.             Input #1, WordList$(i)
144.             'Cls: Locate 2, 1: Print i
145.         Wend
146.         Close #1
147.  
148.         ' test load of file, find last 10 items
149.         'For i = 199651 - 10 To 199651
150.         '    Print WordList$(i)
151.         'Next
152.         'Sleep    OK loading
153.  
154.         Open "Boggle 1 Point Words.txt" For Input As #1
155.         Print "Loading Boggle 1 Point Words.txt for AI..."
156.         i = 0
157.         While Not EOF(1)
158.             i = i + 1
159.             Input #1, OnePointList$(i)
160.         Wend
161.         Close #1
162.  
163.         ' load dx(), dy() for testing the legality of words built from board
164.         dx(0) = -1: dy(0) = -1 ' this is for AI to find words
165.         dx(1) = 0: dy(1) = -1
166.         dx(2) = 1: dy(2) = -1
167.         dx(3) = -1: dy(3) = 0
168.         dx(4) = 1: dy(4) = 0
169.         dx(5) = -1: dy(5) = 1
170.         dx(6) = 0: dy(6) = 1
171.         dx(7) = 1: dy(7) = 1
172.  
173.         ' These are the 16 Dice with 6 Faces of a Letter need for Boggle
174.         Dim Di$(0 To 15) ' this for 16 di, 6 letters per
175.         Di$(1) = "RIFOBX"
176.         Di$(2) = "IFEHEY"
177.         Di$(3) = "DENOWS"
178.         Di$(4) = "UTOKND"
179.         Di$(5) = "HMSRAO"
180.         Di$(6) = "LUPETS"
181.         Di$(7) = "ACITOA"
182.         Di$(8) = "YLGKUE"
183.         Di$(9) = "QBMJOA"
184.         Di$(10) = "EHISPN"
185.         Di$(11) = "VETIGN"
186.         Di$(12) = "BALIYT"
187.         Di$(13) = "EZAVND"
188.         Di$(14) = "RALESC"
189.         Di$(15) = "UWILRG"
190.         Di$(0) = "PACEMD"
191.  
192.         Dim Numbers(0 To 15) ' load numbers for shuffling die order
193.         For i = 0 To 15
194.             Numbers(i) = i
195.         Next
196.         BeenHere = -1
197.     End If
198.  
199.     'now get the game going
200.     For i = 15 To 1 Step -1 'shuffle die
201.         Swap Numbers(i), Numbers(Int(Rnd * (i + 1)))
202.     Next
203.     'For i = 1 To 16: Print Numbers(i);: Next: Print   ' check the shuffle
204.     For i = 0 To 15 'choosing random face of die = 1 Letter
205.         Index2ColRow i, c, r
206.         Board$(c, r) = Mid$(Di$(Numbers(i)), Int(Rnd * 6) + 1, 1)
207.     Next
208.     ' now set timer + 180
209.     BoggleTime = Timer(.01)
210.     _Font 16
211. End Sub
212.  
213. Sub DisplayBoard
214.     Dim row, col
215.     _Font f48
216.     For row = 0 To 3 '  display the board
217.         For col = 0 To 3
218.             Line ((col + 1) * 60 - 5, (row + 1) * 60 - 5)-Step(54, 54), &HFF2020FF, BF 'face color or die
219.             If Board$(col, row) = "Q" Then 'If face has a Q it is supposed to be "Qu"
220.                 _Font f30
221.                 Color &HFF661111 'shade
222.                 _PrintString ((col + 1) * 60 - 4, (row + 1) * 60 + 11), "Q"
223.                 _PrintString ((col + 1) * 60 + 24, (row + 1) * 60 + 11), "U"
224.                 Color &HFFBBBBBB 'letter
225.                 _PrintString ((col + 1) * 60 - 7, (row + 1) * 60 + 9), "Q"
226.                 _PrintString ((col + 1) * 60 + 22, (row + 1) * 60 + 9), "U"
227.                 _Font f48
228.             Else
229.                 Color &HFF661111 'shade
230.                 _PrintString ((col + 1) * 60 + 2, (row + 1) * 60 + 2), Board$(col, row)
231.                 Color &HFFBBBBBB 'letter
232.                 _PrintString ((col + 1) * 60, (row + 1) * 60), Board$(col, row)
233.             End If
234.         Next
235.     Next
236. End Sub
237.  
238. Function ColRow2Index& (row As Long, col As Long) ' convert a board letter to index (not needed yet?)
239.     ColRow2Index& = row * 4 + col
240. End Function
241. Sub Index2ColRow (indexIn As Long, rowOut As Long, colOut As Long) 'convert die index to board col, row
242.     colOut = indexIn Mod 4: rowOut = indexIn \ 4
243. End Sub
244.  
245. Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
246.     Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
247.     curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
248.     dpos = InStr(curpos, SplitMeString, delim)
249.     Do Until dpos = 0
250.         loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
251.         arrpos = arrpos + 1
252.         If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
253.         curpos = dpos + LD
254.         dpos = InStr(curpos, SplitMeString, delim)
255.     Loop
256.     loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
257.     ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
258. End Sub
259.  
260. Function Find& (SortedArr$(), x$) ' if I am using this only to find words in dictionary, I can mod to optimize
261.     Dim As Long low, hi, test
262.     low = LBound(SortedArr$): hi = UBound(SortedArr$)
263.     While low <= hi
264.         test = Int((low + hi) / 2)
265.         If SortedArr$(test) = x$ Then
266.             Find& = test: Exit Function
267.         Else
268.             If SortedArr$(test) < x$ Then low = test + 1 Else hi = test - 1
269.         End If
270.     Wend
271. End Function
272.  
273. Function wordBuildOK& (w$) ' this function checks to see that the was constructed (or is constructable with the given board).
274.     Dim As Long r, c, test
275.     Dim copy$(-1 To 4, -1 To 4), first$
276.     For r = 0 To 3
277.         For c = 0 To 3
278.             copy$(c, r) = Board$(c, r)
279.         Next
280.     Next
281.  
282.     first$ = Mid$(w$, 1, 1)
283.     For r = 0 To 3
284.         For c = 0 To 3
285.             If copy$(c, r) = first$ Then 'cell letter matches first letter in word
286.                 test = findCell&(c, r, w$, 2, copy$())
287.                 If test Then wordBuildOK& = -1: Exit Function ' ah ha! maybe it keeps trying when we are supposed to be done, fix?
288.             End If
289.         Next
290.     Next
291. End Function
292.  
293. 'recursively called starting from wordBuildOK&
294. Function findCell& (startX As Long, startY As Long, word$, index As Long, Arr$()) ' want to setup recursive searcher
295.     Dim As Long d, x, y, i, r, c, test
296.     Dim w$
297.     'make own set of variables for this function  (attempt to debug but did not fix anything)
298.     Dim a$(-1 To 4, -1 To 4)
299.     For r = 0 To 3
300.         For c = 0 To 3
301.             a$(c, r) = Arr$(c, r)
302.         Next
303.     Next
304.     i = index: w$ = word$: y = startY: x = startX
305.     If i > Len(w$) Then findCell = -1: Exit Function
306.     a$(x, y) = "" 'so wont be used again
307.     For d = 0 To 7
308.         If a$(x + dx(d), y + dy(d)) = Mid$(w$, i, 1) Then
309.             test = findCell&(x + dx(d), y + dy(d), w$, i + 1, a$())
310.             If test Then findCell& = -1: Exit Function
311.         End If
312.     Next
313. End Function
314.  
315. Function AIwords$ (timeLimit As Double) 'returns a space delimiter string of 1 point words that can be constructed from board in limited time
316.     Dim As Double startTime, checkTime
317.     Dim As Long i, r, c, OK, dp, l, ub
318.     Dim l$, letters$, b$
319.     startTime = Timer(.01)
320.     ub = UBound(OnePointList$)
321.     ' get a non redundant list of letters from board
322.     For r = 0 To 3
323.         For c = 0 To 3
324.             l$ = Board$(c, r)
325.             If (r = 0) And (c = 0) Then
326.                 letters$ = l$
327.             Else
328.                 If InStr(letters$, l$) <= 0 Then '  insrt letter
329.                     OK = 0
330.                     For i = 1 To Len(letters$)
331.                         If Asc(l$) < Asc(letters$, i) Then ' insert spotted
332.                             If i = 1 Then
333.                                 letters$ = l$ + letters$: OK = -1: Exit For
334.                             Else
335.                                 letters$ = Mid$(letters$, 1, i - 1) + l$ + Mid$(letters$, i)
336.                                 OK = -1: Exit For
337.                             End If
338.                         End If
339.                     Next
340.                     If OK = 0 Then letters$ = letters$ + l$
341.                 End If
342.             End If
343.         Next
344.     Next
345.     'check if this is OK so far  OK finally!  This is 3rd time I needed to exit when found
346.     ' AIwords$ = letters$
347.     'now letters of board are in alpha order
348.     dp = 1 'place in dict
349.     For l = 1 To Len(letters$) ' advance place in list$ by one until the word > letter
350.         While Asc(OnePointList$(dp), 1) < Asc(letters$, l)
351.             dp = dp + 1
352.             If dp > ub Then GoTo fini
353.             If Timer(.01) - startTime < 0 Then checkTime = Timer(.01) + 24 * 60 * 60 Else checkTime = Timer(.01)
354.             If checkTime - startTime > timeLimit Then GoTo fini
355.         Wend
356.         'now start testing words
357.         While Asc(OnePointList$(dp), 1) = Asc(letters$, l)
358.             If wordBuildOK&(OnePointList$(dp)) Then
359.                 If b$ = "" Then b$ = OnePointList$(dp) Else b$ = b$ + " " + OnePointList$(dp)
360.             End If
361.             dp = dp + 1
362.             If dp > ub Then GoTo fini
363.             If Timer(.01) - startTime < 0 Then checkTime = Timer(.01) + 24 * 60 * 60 Else checkTime = Timer(.01)
364.             If checkTime - startTime > timeLimit Then GoTo fini
365.         Wend
366.     Next
367.  
368.     fini:
369.     AIwords$ = b$
370. End Function
371.  
372. Function qw$ (w$) 'insert the u into a q letter word
373.     Dim As Long p
374.     p = InStr(w$, "Q")
375.     If p Then qw$ = Mid$(w$, 1, p) + "U" + Mid$(w$, p + 1) Else qw$ = w$
376. End Function
377.  
378. Function removeRepeats$ (s$) ' s$ is space delimited word list
379.     ReDim t$(1 To 1), b$
380.     Dim As Long ub, i, j, ok
381.     Split s$, " ", t$()
382.     ub = UBound(t$)
383.     For i = 1 To ub
384.         ok = -1
385.         For j = 1 To i - 1
386.             If t$(i) = t$(j) Then ok = 0: Exit For
387.         Next
388.         If ok Then
389.             If b$ = "" Then b$ = t$(i) Else b$ = b$ + " " + t$(i)
390.         End If
391.     Next
392.     removeRepeats$ = b$
393. End Function
394.  
395. Function score& (a() As String)
396.     Dim As Long i, s
397.     For i = 1 To UBound(a)
398.         Select Case Len(a(i))
399.             Case 3, 4: s = s + 1
400.             Case 5: s = s + 2
401.             Case 6: s = s + 3
402.             Case 7: s = s + 5
403.             Case Is > 7: s = s + 11
404.         End Select
405.     Next
406.     score& = s
407. End Function
408.  

 

 

Dang, I missed god.

Title: Re: Boggle play against AI - WIP
Post by: SMcNeill on January 15, 2022, 01:08:04 pm

Why doesn't the AI find PEAT and DIE and TAP?

It's overlooking a lot of easy words.

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 15, 2022, 01:56:51 pm

Quote from: SMcNeill on January 15, 2022, 01:08:04 pm

Why doesn't the AI find PEAT and DIE and TAP?

It's overlooking a lot of easy words.

They were on my list ("a lot of easy words"), at time of reckoning matching words are eliminated and then words remaining are scored.

You see those words on the screen shot before the last (when I had words in my list). The AI of course found every 3-4 letter word I did (wiping out my list) plus a couple more, it gets to keep the couple more :)

I will add a label about typing in the words while the timer is going, but I have bigger fish to fry. I want that 17th die to eliminate special handling of Qwords that really threw a monkey wrench in coding this game and AI's list will have access to ALL 3 and 4 letter words. There many q words that don't use u after the q, why should we shun them?

We play games but we also expand vocabulary, spelling and data processing skills ie keep our minds active and growing.

Title: Re: Boggle play against AI - WIP
Post by: jack on January 15, 2022, 02:46:59 pm

Hi bplus
about the program simply vanishing while reading the dictionary, try Dim WordList$(1 To 300000) even though the number of words is only 279499
but where can I find "Boggle 1 Point Words.txt" ?

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 15, 2022, 03:22:33 pm

Quote from: jack on January 15, 2022, 02:46:59 pm

Hi bplus
about the program simply vanishing while reading the dictionary, try Dim WordList$(1 To 300000) even though the number of words is only 279499
but where can I find "Boggle 1 Point Words.txt" ?

Apologies to all, I forgot you guys need the files to play, dang sorry.

Use the link for the giant Collins Scrabble Word (2019).txt files, I would get the dictionary with the word list to learn what some of these crazy 3-4 letter words are!? You can find the link right under the Boggle Title line at the start of the bas source of Boggle 1.

And here is the zip for the Bas Make codes ran to create smaller files from the Collins word list.

+1) The 3 to 10 Letter Words.txt is my fix for being unable to load the entire Collins Word List as mention in reply above. Might be able to get more Letter words thn 10 but I roughing out a running game not optimizing.
This file was used to load most of the words into an array in the app, as all the words wont fit.

+2) The Boggle 1 Point Words.txt are what the AI uses to attempt legal constructions from the given active game board. One point words only have 3 or 4 Letters.

So in the zip you have the txt file lists and the code that built them from the Collins files and the Boggle 1 source, but not the Collins files.
 

Thanks @jack for bringing this to my attention.


You know since the frick'n AI is so good at finding words, I think I will restrict it to 5 letters or more and give all the one pointers the player finds to the player. That will occupy the AI for finding longer words (and getting bigger points unless player finds them too.)

That may make a game the player could win! ;-)) and it would be more interesting checking out what the AI finds.

Title: Re: Boggle play against AI - WIP
Post by: SMcNeill on January 16, 2022, 05:28:39 am

Give the AI an education level that the user can select from 1 to 10.

1 has a 10% chance to "know" a word if it finds a match; 10 has a 100% chance.

For example, the AI finds "cat", but with the handicap, it only has a 10 * level percent chance of keeping the word in its list.

Seems simple enough to implement and allows for some customization for game difficulty.

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 16, 2022, 08:46:04 am

Quote from: SMcNeill on January 16, 2022, 05:28:39 am

Give the AI an education level that the user can select from 1 to 10.

1 has a 10% chance to "know" a word if it finds a match; 10 has a 100% chance.

For example, the AI finds "cat", but with the handicap, it only has a 10 * level percent chance of keeping the word in its list.

Seems simple enough to implement and allows for some customization for game difficulty.

Ha! yeah do something? I tried the 5 or more letters to AI only taking away all 3-4 letter words, it still beats the crap out of the player (me) with higher point words!

I gotta show all the words that can be found on the board, it is incredible!

BTW I got the special handling of Q words removed added the 17th dice and set it up to click the letters and right click to enter the word through the legalConstructionOK function and the Dictionary check as with the keyboard inputs.

Title: Re: Boggle play against AI - WIP
Post by: _vince on January 16, 2022, 12:33:02 pm

bplus is into letters now instead of graphics, sad times

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 16, 2022, 12:34:16 pm

 Boggle 2 update with Qwords special handling gone, click letters and Right click to "Enter" word, one word list load that AI has full access to so we can see what we could't when searching for words ourself. I could only get a list of 3 to 12 letter Words to load and last night that quit working for some unknown reason. If that happens to you, I left a smaller file of 3 to 10 letter words to load mod the Sub NewBoard that initializes the game:

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Boggle 2" ' b+ start 2022-01-12
3. ' Scabble Word List and Dictionary
4. ' ref dictionary: https://boardgames.stackexchange.com/questions/38366/latest-collins-scrabble-words-list-in-text-file
5. ' Die configurations
6. ' https://boardgames.stackexchange.com/questions/29264/boggle-what-is-the-dice-configuration-for-boggle-in-various-languages
7. ' Thank you!
8.  
9. ' 2022-01-14 status have the board display separated out from New Board and Game initialization
10. ' have timer system and display working next to board display
11. ' have player input system working
12. '   1. check word in dictionary working
13. '   2. check that word can legally be built from board is funky! sometimes works sometimes not 50/50 for legit builds yuck
14. '     How to debug? Todays task is get this abolutely critical function working so the AI would be fairly easy to do.
15. ' Oh I had to modify the Collins Word list to get a size that would fit into a variable length string array, 279496 words
16. ' kept crashing QB64 without error messages when reached about 260,000 words so now I have a list for words with lengths of
17. ' between 3 and 10, still 199,651 words!
18. ' 2202-01-14 Hurray! Function wordBuildOK& is fixed, a very simple logic bug. I continued to check for builds of word after
19. ' I got confirmation one of the builds was possible. It kept checking if there was more than one place the first letter of word
20. ' appeared. The function is crucial for AI testing if words are buildable. I can get started on that today now that bug is
21. ' fixed. Man! I had this fixed almost immediately, I had to exit the Function when the recursive function findCell& called from
22. ' it found a positive result.
23.  
24. ' 2022-01-15 qw$() function to handle the Q letter, function to handle scoring, main removes matching words on the 2 lists.
25. ' you should be able to type 2 letters with (qu) square and get a 3 letter word.
26.  
27. ' 2022-01-15 screw the die with face Q(u) with implied u, adding a 17th die with AEIOUU and removing all the special handling
28. ' for that implied u crap! I don't think this will ruin the game but only make it better and less difficlut to code.
29. ' Fix the spelling of reckoning :)  OK new word files made for Boggle 2: AI Check Words is HUGE! Almost 35 X's more and longer
30. ' words, words 5 letters and longer. The Word List file has been expanded from 3 to 10 letter words to 3 to 12 letter words.
31. ' Dang! It's worse the points the AI collects from big words times the point values they are worth...
32. ' OK more handicap, AI concedes all 3-6 letters words to player and gets points only for 7+ letter words. Is it fair now?
33. ' Too much! Try concedes 3-5 but fight for 6+ letter words.
34.  
35. ' 2022-01-16 Yesterday I was able to use 2 large word lists from : 3 - 12 Letter Words.txt (249,702)
36. ' and AI Check Words.txt (229,745) they loaded fine all afternoon. Then I decided to use the 3-12 letter words for the
37. ' AI check words list so I only had to load one file! So I change the code to do that and suddenly the 3-12 Letter Words.txt
38. ' was quitting like there were more words than it could load (no error message, no subscript out of range you get with an array
39. ' dim'd too small for # of items to put in it), QB64 just bugged out and quit ??? Just like when I was trying to load the
40. ' whole file.
41. '    So today I m trying jack's idea to over size the dim of the array to load into and track the number going in with a
42. ' variable NTopWord. And I am going to try and load a bigger 3-16 Letter Words.txt file. NOPE!
43. ' The 3-12 list is loading again today, but no garantee it will work for others or me in future as it quit last night.
44. ' Try loading up Browser and run other stuff, maybe QB64 variable length string loads in one array is limited. Still OK.
45. ' Have no idea why it works for .5 day and later doesn't ????
46.  
47. ' 2022-01-16 Boggle 2 post: I will have the 3 to 10 Letter Words.txt file to load into game if you or I have problems loading the
48. ' 3 to 12 Letter Words.txt file. So just Boggle 2 and 2 word files in zip.
49.  
50. '  =================================== Sound Signals =========================================================
51. ' Oh a high pitched peep is a sound signalling that the word enetered can't be legally built from board.
52. ' A Beep is a signal the word is not in dictionary.
53.  
54. Randomize Timer
55. Const TimeLimit = 180 ' actual game time is 3 minutes = 180 secs
56. Const PrintLine = 20 ' row where I can start display of user inputs below Board display on screen.
57. Dim Shared Board$(3, 3), WordList$(1 To 280000) ' < this is over sized array # words is 279369 try jacks idea of oversized array
58. Dim Shared As Long f48, f30, dx(7), dy(7), NTopWord
59. Dim Shared As Double BoggleTime, elapsed
60. Dim w$, k$, player$, AI$
61. Dim As Long pScore, aiScore, uba, ubp, i, j, mx, my, mbL, mbR, row, col
62. Screen _NewImage(800, 600, 32)
63. _ScreenMove 200, 100
64. _PrintMode _KeepBackground
65.  
66. ' quick board for testin working mouse locations for clicking letters
67. 'NewBoard
68. 'While _KeyDown(27) = 0
69. '    Cls
70. '    DisplayBoard
71. '    _Font 16
72. '    While _MouseInput: Wend
73. '    mx = _MouseX: my = _MouseY: mbL = _MouseButton(1): mbR = _MouseButton(2)
74. '    row = (my - 80) / 60: col = (mx - 80) / 60 ' ?? not -60 but more
75. '    Print col, row, mbL, mbR
76. '    _Display
77. '    _Limit 60
78. 'Wend
79.  
80. Do
81.     NewBoard ' display timer and allow input of words from user for 3 minutes
82.     DisplayBoard
83.     elapsed = 0: player$ = "": w$ = ""
84.     While elapsed < TimeLimit ' do stuff   <<<<<<<<<<<<<<<<<<<<<< off while debug wordBuildOK
85.         Cls
86.         DisplayBoard
87.         elapsed = Timer(.01) - BoggleTime
88.         If elapsed < 0 Then elapsed = 24 * 60 * 60 + Timer(.01) - BoggleTime ' midnight problem add aday of seconds to timer and subtr boogle
89.         _Font f48
90.         Color &HFFFFFF00
91.         _PrintString (300, 240), _Trim$(Str$(TimeLimit - Int(elapsed)))
92.  
93.         _Font 16
94.         Color _RGB32(200, 200, 255)
95.  
96.         'some help
97.         Locate 5, 50: Print "Use Keyboard or Mouse to add letters to word."
98.         Locate 6, 50: Print " Backspace will clear last letter."
99.         Locate 7, 50: Print " Esc or Ctrl+C will clear word started."
100.         Locate 8, 50: Print " Enter or Right Mouse to checks word > list."
101.  
102.         'add mouse controls
103.         While _MouseInput: Wend
104.         mx = _MouseX: my = _MouseY: mbL = _MouseButton(1): mbR = _MouseButton(2)
105.         row = (my - 80) / 60: col = (mx - 80) / 60 ' ?? not -60 but more
106.         If mbL Then
107.             _Delay .25
108.             If -1 < row And row < 4 Then
109.                 If -1 < col And col < 4 Then
110.                     w$ = w$ + Board$(col, row) ' add letter to w$ build
111.                 End If
112.             End If
113.         End If
114.         If mbR Then ' same as hitting Enter on keyboard
115.             _Delay .25
116.             If wordBuildOK&(w$) Then ' legal build
117.                 If Find&(WordList$(), w$) Then ' check words in dictionary before add to player$
118.                     If player$ = "" Then player$ = w$ Else player$ = player$ + " " + w$
119.                 Else
120.                     Beep
121.                 End If
122.             Else
123.                 Sound 3000, 1
124.             End If
125.             w$ = ""
126.         End If
127.  
128.         k$ = UCase$(InKey$) ' compare to all caps
129.         If Len(k$) Then 'handle 1 and 2 char key presses, maybe replace with _keyhit later
130.             Select Case Len(k$)
131.                 Case 1
132.                     Select Case Asc(k$)
133.                         Case 3 'Ctrl + C   another way to clear?
134.                             w$ = ""
135.                         Case 8 ' backspace          more to do
136.                             If Len(w$) Then w$ = Left$(w$, Len(w$) - 1)
137.                         Case 13
138.                             If wordBuildOK&(w$) Then ' legal build
139.                                 If Find&(WordList$(), w$) Then ' check words in dictionary before add to player$
140.                                     If player$ = "" Then player$ = w$ Else player$ = player$ + " " + w$
141.                                 Else
142.                                     Beep
143.                                 End If
144.                             Else
145.                                 Sound 3000, 1
146.                             End If
147.                             w$ = ""
148.                         Case 27 'esc
149.                             w$ = "" ': exit ?
150.                         Case Else
151.                             If 63 < Asc(k$) And Asc(k$) < 91 Then w$ = w$ + k$
152.                     End Select
153.             End Select
154.         End If
155.         Locate PrintLine, 1: Print w$
156.         Locate PrintLine + 1, 1: Print player$
157.         _Display
158.         _Limit 60
159.     Wend
160.     _AutoDisplay
161.     _PrintString (400, 240), "Times up!"
162.  
163.     'lets see what the AI comes up with
164.     AI$ = AIwords$(5) ' new much larger much longer words
165.     Locate PrintLine + 4, 1: Print "AI: "; AI$
166.     Print "          zzz... Press any for the time of reckoning,"
167.     Print "   matching words on 2 lists will be removed and the round scored."
168.     Sleep
169.     ' evalaute results (remove matching words in lists) and score
170.     Cls
171.     DisplayBoard
172.     _Font 16
173.     player$ = removeRepeats$(player$) ' remove words input 2 or more times
174.     ReDim p(1 To 1) As String 'setup to convert to an array
175.     Split player$, " ", p() ' convert player$ to array
176.     ubp = UBound(p) ' quick count of words because array is base 1
177.  
178.     ReDim a(1 To 1) As String ' likewise for AI's string list
179.     Split AI$, " ", a()
180.     uba = UBound(a)
181.  
182.     For i = 1 To uba ' Remove matching words from lists
183.         For j = 1 To ubp
184.             If a(i) = p(j) Then a(i) = "": p(j) = ""
185.         Next
186.     Next
187.     pScore = score&(p()): aiScore = score&(a()) ' scores done
188.  
189.     AI$ = "": player$ = "" ' reset strings for rebuild
190.     For i = 1 To uba ' rebuild AI's non matching words
191.         If a(i) <> "" Then AI$ = AI$ + " " + a(i)
192.     Next
193.     For i = 1 To ubp ' rebuild players non matching words (if any)
194.         If p(i) <> "" Then player$ = player$ + " " + p(i)
195.     Next
196.     'display results of reckoning for round
197.     Locate PrintLine, 1: Print "Player:"; player$; " Score:"; pScore
198.     Locate PrintLine + 3, 1: Print "AI:"; AI$; " Score:"; aiScore
199.     Print "      zzz... read em and weep, press any for another round of humiliation :)"
200.     Sleep
201. Loop
202.  
203. Sub NewBoard
204.     Static BeenHere, Di$(), Numbers()
205.     Dim As Long i, r, c
206.  
207.     If BeenHere = 0 Then 'load and initialize all the one time stuff
208.         ' load fonts
209.         f48 = _LoadFont("Arial.ttf", 48, "MONOSPACE")
210.         f30 = _LoadFont("Arial.ttf", 30, "MONOSPACE")
211.         If f48 <= 0 Then Print "Sub NewBoard: Font did not load, goodbye.": End
212.  
213.         'load abrev Dictionary ======================================== comment out while debug
214.         Open "3 to 12 Letter Words.txt" For Input As #1 ' for some reason 3-12 stopped loading on me
215.         '  "3 to 16 Letter Words.txt" new bigger file than loaded
216.         ' jack idea didn't work
217.         ' lets see if 3 to 12 will load this morning, yes it's loading this morning (Browser off)
218.  
219.         Print "Loading 3 to 12 Letter Words from Collins Dictionary..."
220.         While Not EOF(1)
221.             i = i + 1
222.             Input #1, WordList$(i)
223.             'Cls: Locate 2, 1: Print i
224.         Wend
225.         Close #1
226.         NTopWord = i
227.         Print "Big Word File loaded!,"; NTopWord; " items   zzz..."
228.         Sleep
229.  
230.         ' test load of file, find last 10 items
231.         'For i = 199651 - 10 To 199651  ' when testing 3 to 10 Letter Words.txt
232.         '    Print WordList$(i)
233.         'Next
234.         'Sleep    OK loading
235.  
236.         ' When using a separate word file for AI to "Handicap" it, no good just adds time to load stuff
237.         'Open "AI Check Words.txt" For Input As #1
238.         'Print "Loading AI Check Words.txt for AI, 6 to 12 letter words same dictionary..."
239.         'i = 0
240.         'While Not EOF(1)
241.         '    i = i + 1
242.         '    Input #1, AICheckWords$(i)
243.         'Wend
244.         'Close #1
245.  
246.         ' load dx(), dy() for testing the legality of words built from board
247.         dx(0) = -1: dy(0) = -1 ' this is for AI to find words
248.         dx(1) = 0: dy(1) = -1
249.         dx(2) = 1: dy(2) = -1
250.         dx(3) = -1: dy(3) = 0
251.         dx(4) = 1: dy(4) = 0
252.         dx(5) = -1: dy(5) = 1
253.         dx(6) = 0: dy(6) = 1
254.         dx(7) = 1: dy(7) = 1
255.  
256.         ' These are the 17 Dice with 6 Faces of a Letter need for Boggle
257.         Dim Di$(0 To 16)
258.         Di$(0) = "PACEMD"
259.         Di$(1) = "RIFOBX"
260.         Di$(2) = "IFEHEY"
261.         Di$(3) = "DENOWS"
262.         Di$(4) = "UTOKND"
263.         Di$(5) = "HMSRAO"
264.         Di$(6) = "LUPETS"
265.         Di$(7) = "ACITOA"
266.         Di$(8) = "YLGKUE"
267.         Di$(9) = "QBMJOA"
268.         Di$(10) = "EHISPN"
269.         Di$(11) = "VETIGN"
270.         Di$(12) = "BALIYT"
271.         Di$(13) = "EZAVND"
272.         Di$(14) = "RALESC"
273.         Di$(15) = "UWILRG"
274.         Di$(16) = "AEIOUU" ' b+ mod Boggle 2 to remove all special handling of Q words!!!
275.  
276.         Dim Numbers(0 To 16) ' load numbers for shuffling die order
277.         For i = 0 To 16
278.             Numbers(i) = i
279.         Next
280.         BeenHere = -1
281.     End If
282.  
283.     'now get the game going
284.     For i = 16 To 1 Step -1 'shuffle die
285.         Swap Numbers(i), Numbers(Int(Rnd * (i + 1)))
286.     Next
287.     'For i = 1 To 16: Print Numbers(i);: Next: Print   ' check the shuffle
288.     For i = 0 To 15 'choosing random face of die = 1 Letter
289.         Index2ColRow i, c, r
290.         Board$(c, r) = Mid$(Di$(Numbers(i)), Int(Rnd * 6) + 1, 1) ' one die gets is left out now Boggle 2
291.     Next
292.     ' now set timer + 180
293.     BoggleTime = Timer(.01)
294.     _Font 16
295. End Sub
296.  
297. Sub DisplayBoard
298.     Dim row, col
299.     _Font f48
300.     For row = 0 To 3 '  display the board
301.         For col = 0 To 3
302.             Line ((col + 1) * 60 - 5, (row + 1) * 60 - 5)-Step(54, 54), &HFF2020FF, BF 'face color or die
303.             Color &HFF661111 'shade
304.             _PrintString ((col + 1) * 60 + 2, (row + 1) * 60 + 2), Board$(col, row)
305.             Color &HFFBBBBBB 'letter
306.             _PrintString ((col + 1) * 60, (row + 1) * 60), Board$(col, row)
307.         Next
308.     Next
309. End Sub
310.  
311. 'might not need in final cut
312. Function ColRow2Index& (row As Long, col As Long) ' convert a board letter to index (not needed yet?)
313.     ColRow2Index& = row * 4 + col
314. End Function
315.  
316. Sub Index2ColRow (indexIn As Long, rowOut As Long, colOut As Long) 'convert die index to board col, row
317.     colOut = indexIn Mod 4: rowOut = indexIn \ 4
318. End Sub
319.  
320. Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
321.     Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
322.     curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
323.     dpos = InStr(curpos, SplitMeString, delim)
324.     Do Until dpos = 0
325.         loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
326.         arrpos = arrpos + 1
327.         If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
328.         curpos = dpos + LD
329.         dpos = InStr(curpos, SplitMeString, delim)
330.     Loop
331.     loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
332.     ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
333. End Sub
334.  
335. Function Find& (SortedArr$(), x$) ' if I am using this only to find words in dictionary, I can mod to optimize
336.     Dim As Long low, hi, test
337.     low = LBound(SortedArr$): hi = UBound(SortedArr$)
338.     While low <= hi
339.         test = Int((low + hi) / 2)
340.         If SortedArr$(test) = x$ Then
341.             Find& = test: Exit Function
342.         Else
343.             If SortedArr$(test) < x$ Then low = test + 1 Else hi = test - 1
344.         End If
345.     Wend
346. End Function
347.  
348. ' This function checks to see that the word w$ is legally constructable with the given board.
349. ' This function requires the recurive Function findCell& (startX As Long, startY As Long, word$, index As Long, Arr$())
350. Function wordBuildOK& (w$)
351.     Dim As Long r, c, test
352.     Dim copy$(-1 To 4, -1 To 4), first$
353.     For r = 0 To 3
354.         For c = 0 To 3
355.             copy$(c, r) = Board$(c, r)
356.         Next
357.     Next
358.     first$ = Mid$(w$, 1, 1)
359.     For r = 0 To 3
360.         For c = 0 To 3
361.             If copy$(c, r) = first$ Then 'cell letter matches first letter in word
362.                 test = findCell&(c, r, w$, 2, copy$())
363.                 If test Then wordBuildOK& = -1: Exit Function ' ah ha! maybe it keeps trying when we are supposed to be done, fix?
364.             End If
365.         Next
366.     Next
367. End Function
368.  
369. 'recursively called starting from wordBuildOK&
370. Function findCell& (startX As Long, startY As Long, word$, index As Long, Arr$()) ' want to setup recursive searcher
371.     Dim As Long d, x, y, i, r, c, test
372.     Dim w$
373.     'make own set of variables for this function  (attempt to debug but did not fix anything)
374.     Dim a$(-1 To 4, -1 To 4)
375.     For r = 0 To 3
376.         For c = 0 To 3
377.             a$(c, r) = Arr$(c, r)
378.         Next
379.     Next
380.     i = index: w$ = word$: y = startY: x = startX
381.     If i > Len(w$) Then findCell = -1: Exit Function
382.     a$(x, y) = "" 'so wont be used again
383.     For d = 0 To 7
384.         If a$(x + dx(d), y + dy(d)) = Mid$(w$, i, 1) Then
385.             test = findCell&(x + dx(d), y + dy(d), w$, i + 1, a$())
386.             If test Then findCell& = -1: Exit Function
387.         End If
388.     Next
389. End Function
390.  
391. Function AIwords$ (timeLimit As Double) 'returns a space delimiter string of 1 point words that can be constructed from board in limited time
392.     Dim As Double startTime, checkTime
393.     Dim As Long i, r, c, OK, dp, l
394.     Dim l$, letters$, b$
395.     startTime = Timer(.01)
396.     'ub = UBound(WordList$)  now is NTopWord
397.     ' get a non redundant list of letters from board and put them in alpha order
398.     For r = 0 To 3
399.         For c = 0 To 3
400.             l$ = Board$(c, r)
401.             If (r = 0) And (c = 0) Then
402.                 letters$ = l$
403.             Else
404.                 If InStr(letters$, l$) <= 0 Then '  insrt letter
405.                     OK = 0
406.                     For i = 1 To Len(letters$) '            where?
407.                         If Asc(l$) < Asc(letters$, i) Then ' here!
408.                             letters$ = Mid$(letters$, 1, i - 1) + l$ + Mid$(letters$, i)
409.                             OK = -1: Exit For
410.                         End If
411.                     Next
412.                     If OK = 0 Then letters$ = letters$ + l$
413.                 End If
414.             End If
415.         Next
416.     Next
417.     'check if this is OK so far  OK finally!  This is 3rd time I needed to exit when found
418.     ' AIwords$ = letters$
419.     'now letters of board are in alpha order
420.     dp = 1 'place in dict
421.     For l = 1 To Len(letters$) ' advance place in list$ by one until the word > letter
422.         While Asc(WordList$(dp), 1) < Asc(letters$, l)
423.             dp = dp + 1
424.             If dp > NTopWord Then GoTo fini
425.             If Timer(.01) - startTime < 0 Then checkTime = Timer(.01) + 24 * 60 * 60 Else checkTime = Timer(.01)
426.             If checkTime - startTime > timeLimit Then GoTo fini
427.         Wend
428.         'now start testing words
429.         While Asc(WordList$(dp), 1) = Asc(letters$, l)
430.             If wordBuildOK&(WordList$(dp)) Then
431.                 If b$ = "" Then b$ = WordList$(dp) Else b$ = b$ + " " + WordList$(dp)
432.             End If
433.             dp = dp + 1
434.             If dp > NTopWord Then GoTo fini
435.             If Timer(.01) - startTime < 0 Then checkTime = Timer(.01) + 24 * 60 * 60 Else checkTime = Timer(.01)
436.             If checkTime - startTime > timeLimit Then GoTo fini
437.         Wend
438.     Next
439.  
440.     fini:
441.     AIwords$ = b$
442. End Function
443.  
444. ' Dont need to special handling of Q words
445. 'Function qw$ (w$) 'insert the u into a q letter word
446. '    Dim As Long p
447. '    p = InStr(w$, "Q")
448. '    If p Then qw$ = Mid$(w$, 1, p) + "U" + Mid$(w$, p + 1) Else qw$ = w$
449. 'End Function
450.  
451. Function removeRepeats$ (s$) ' s$ is space delimited word list
452.     ReDim t$(1 To 1), b$
453.     Dim As Long ub, i, j, ok
454.     Split s$, " ", t$()
455.     ub = UBound(t$)
456.     For i = 1 To ub
457.         ok = -1
458.         For j = 1 To i - 1
459.             If t$(i) = t$(j) Then ok = 0: Exit For
460.         Next
461.         If ok Then
462.             If b$ = "" Then b$ = t$(i) Else b$ = b$ + " " + t$(i)
463.         End If
464.     Next
465.     removeRepeats$ = b$
466. End Function
467.  
468. Function score& (a() As String)
469.     Dim As Long i, s
470.     For i = 1 To UBound(a)
471.         Select Case Len(a(i))
472.             Case 3, 4: s = s + 1
473.             Case 5: s = s + 2
474.             Case 6: s = s + 3
475.             Case 7: s = s + 5
476.             Case Is > 7: s = s + 11
477.         End Select
478.     Next
479.     score& = s
480. End Function
481.  

Boggle 2 Before Reckoning:
 

Boggle 2 Post Reckoning:
 

Zip contains 2 txt files of word lists and Boggle 2.bas source, if 3 to 12 Letter Words.txt file does not load, mod the Sub NewBoard to try the 3 to 10 Letter Words.txt file.

My lesson from Boggle 2 is that the AI is too good for any decent challenge between Human and machine, so I will try to use this code to create a Vocabulary and Spelling skills builder program.

Oh! interesting note, for some reason the code would not accept my attempts (yes more than once) of YELL, I wanted to YELL! I cant remember getting a ill-legal build signal or a not found in dictionary signal.

BTW Boggle 2 does signal why it doesn't allow a word into you accumulating list with sounds a high pitch one is not buildable from board and a BEEP is a not found in dictionary signal.

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 16, 2022, 12:39:49 pm

Quote from: _vince on January 16, 2022, 12:33:02 pm

bplus is into letters now instead of graphics, sad times

ehhhh... been doing words for awhile.

I am not best with vocabulary and spelling (or reading for that matter) but maybe I can improve through games?

@_vince you are doing pretty well with the graphics yourself! was it you or Cobalt working on math (or both).

QB64 can make learning fun with creative challenges!

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 16, 2022, 08:51:52 pm

Solved the problem with loading all the words. Now I load none! I converted the 2 Collins files to RA and now my arrays are on disk. Don't really notice less speed, the AI can search the whole word list just fine in a second.

Now after the reckoning you can look up words by pressing h (help with word) instead of any other key.
  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Boggle 3" ' b+ start 2022-01-12
3. ' Scabble Word List and Dictionary
4. ' ref dictionary: https://boardgames.stackexchange.com/questions/38366/latest-collins-scrabble-words-list-in-text-file
5. ' Die configurations
6. ' https://boardgames.stackexchange.com/questions/29264/boggle-what-is-the-dice-configuration-for-boggle-in-various-languages
7. ' Thank you!
8.  
9. ' 2022-01-14 status have the board display separated out from New Board and Game initialization
10. ' have timer system and display working next to board display
11. ' have player input system working
12. '   1. check word in dictionary working
13. '   2. check that word can legally be built from board is funky! sometimes works sometimes not 50/50 for legit builds yuck
14. '     How to debug? Todays task is get this abolutely critical function working so the AI would be fairly easy to do.
15. ' Oh I had to modify the Collins Word list to get a size that would fit into a variable length string array, 279496 words
16. ' kept crashing QB64 without error messages when reached about 260,000 words so now I have a list for words with lengths of
17. ' between 3 and 10, still 199,651 words!
18. ' 2202-01-14 Hurray! Function wordBuildOK& is fixed, a very simple logic bug. I continued to check for builds of word after
19. ' I got confirmation one of the builds was possible. It kept checking if there was more than one place the first letter of word
20. ' appeared. The function is crucial for AI testing if words are buildable. I can get started on that today now that bug is
21. ' fixed. Man! I had this fixed almost immediately, I had to exit the Function when the recursive function findCell& called from
22. ' it found a positive result.
23.  
24. ' 2022-01-15 qw$() function to handle the Q letter, function to handle scoring, main removes matching words on the 2 lists.
25. ' you should be able to type 2 letters with (qu) square and get a 3 letter word.
26.  
27. ' 2022-01-15 screw the die with face Q(u) with implied u, adding a 17th die with AEIOUU and removing all the special handling
28. ' for that implied u crap! I don't think this will ruin the game but only make it better and less difficlut to code.
29. ' Fix the spelling of reckoning :)  OK new word files made for Boggle 2: AI Check Words is HUGE! Almost 35 X's more and longer
30. ' words, words 5 letters and longer. The Word List file has been expanded from 3 to 10 letter words to 3 to 12 letter words.
31. ' Dang! It's worse the points the AI collects from big words times the point values they are worth...
32. ' OK more handicap, AI concedes all 3-6 letters words to player and gets points only for 7+ letter words. Is it fair now?
33. ' Too much! Try concedes 3-5 but fight for 6+ letter words.
34.  
35. ' 2022-01-16 Yesterday I was able to use 2 large word lists from : 3 - 12 Letter Words.txt (249,702)
36. ' and AI Check Words.txt (229,745) they loaded fine all afternoon. Then I decided to use the 3-12 letter words for the
37. ' AI check words list so I only had to load one file! So I change the code to do that and suddenly the 3-12 Letter Words.txt
38. ' was quitting like there were more words than it could load (no error message, no subscript out of range you get with an array
39. ' dim'd too small for # of items to put in it), QB64 just bugged out and quit ??? Just like when I was trying to load the
40. ' whole file.
41. '    So today I m trying jack's idea to over size the dim of the array to load into and track the number going in with a
42. ' variable NTopWord. And I am going to try and load a bigger 3-16 Letter Words.txt file. NOPE!
43. ' The 3-12 list is loading again today, but no garantee it will work for others or me in future as it quit last night.
44. ' Try loading up Browser and run other stuff, maybe QB64 variable length string loads in one array is limited. Still OK.
45. ' Have no idea why it works for .5 day and later doesn't ????
46.  
47. ' 2022-01-16 Boggle 2 post: I will have the 3 to 10 Letter Words.txt file to load into game if you or I have problems loading the
48. ' 3 to 12 Letter Words.txt file. So just Boggle 2 and 2 word files in zip.
49.  
50. '  =================================== Sound Signals =========================================================
51. ' Oh a high pitched peep is a sound signalling that the word enetered can't be legally built from board.
52. ' A Beep is a signal the word is not in dictionary.
53. '=============================================================================================================
54.  
55. ' 2022-01-16 Boggle 3 this may be a fork but I am going to not load the Collins word file into an array
56. ' but use an RA file I created with a bas Make code. I made the word list and the words with definitions of all words!
57. ' BTW the maxLen of a word was 15.
58. ' So first step is to convert code to this change and see how it does, will RA be too slow? We will save time
59. ' loading the file into an array but lose it throughout the game?
60. ' Hey not loading the word file(s) is working fine! AI doesn't seem to take any longer to go through the words.
61. ' Now you can lookup the words you don't know, press h for help with word after the reckoning score update.
62.  
63. Randomize Timer
64. Const NTopWord = 279496
65. Const TimeLimit = 180 ' actual game time is 3 minutes = 180 secs
66. Const PrintLine = 20 ' row where I can start display of user inputs below Board display on screen.
67. Dim Shared Board$(3, 3) ' < this is over sized array # words is 279369 try jacks idea of oversized array
68. Dim Shared As Long f48, f30, dx(7), dy(7)
69. Dim Shared As Double BoggleTime, elapsed
70. Dim Shared rec15 As String * 15
71. Dim w$, k$, player$, AI$
72. Dim rec237 As String * 237
73. Dim As Long pScore, aiScore, uba, ubp, i, j, mx, my, mbL, mbR, row, col, ndef
74. Screen _NewImage(800, 700, 32)
75. _ScreenMove 200, 40
76. _PrintMode _KeepBackground
77.  
78. Do
79.     NewBoard ' display timer and allow input of words from user for 3 minutes
80.     DisplayBoard
81.     elapsed = 0: player$ = "": w$ = ""
82.     While elapsed < TimeLimit ' do stuff   <<<<<<<<<<<<<<<<<<<<<< off while debug wordBuildOK
83.         Cls
84.         DisplayBoard
85.         elapsed = Timer(.01) - BoggleTime
86.         If elapsed < 0 Then elapsed = 24 * 60 * 60 + Timer(.01) - BoggleTime ' midnight problem add aday of seconds to timer and subtr boogle
87.         _Font f48
88.         Color &HFFFFFF00
89.         _PrintString (300, 240), _Trim$(Str$(TimeLimit - Int(elapsed)))
90.  
91.         _Font 16
92.         Color _RGB32(200, 200, 255)
93.  
94.         'some help
95.         Locate 5, 50: Print "Use Keyboard or Mouse to add letters to word."
96.         Locate 6, 50: Print " Backspace will clear last letter."
97.         Locate 7, 50: Print " Esc or Ctrl+C will clear word started."
98.         Locate 8, 50: Print " Enter or Right Mouse to checks word > list."
99.  
100.         'add mouse controls
101.         While _MouseInput: Wend
102.         mx = _MouseX: my = _MouseY: mbL = _MouseButton(1): mbR = _MouseButton(2)
103.         row = (my - 80) / 60: col = (mx - 80) / 60 ' ?? not -60 but more
104.         If mbL Then
105.             _Delay .25
106.             If -1 < row And row < 4 Then
107.                 If -1 < col And col < 4 Then
108.                     w$ = w$ + Board$(col, row) ' add letter to w$ build
109.                 End If
110.             End If
111.         End If
112.         If mbR Then ' same as hitting Enter on keyboard
113.             _Delay .25
114.             If wordBuildOK&(w$) Then ' legal build
115.                 If Find&(w$) Then ' check words in dictionary before add to player$
116.                     If player$ = "" Then player$ = w$ Else player$ = player$ + " " + w$
117.                 Else
118.                     Beep
119.                 End If
120.             Else
121.                 Sound 3000, 1
122.             End If
123.             w$ = ""
124.         End If
125.  
126.         k$ = UCase$(InKey$) ' compare to all caps
127.         If Len(k$) Then 'handle 1 and 2 char key presses, maybe replace with _keyhit later
128.             Select Case Len(k$)
129.                 Case 1
130.                     Select Case Asc(k$)
131.                         Case 3 'Ctrl + C   another way to clear?
132.                             w$ = ""
133.                         Case 8 ' backspace          more to do
134.                             If Len(w$) Then w$ = Left$(w$, Len(w$) - 1)
135.                         Case 13
136.                             If wordBuildOK&(w$) Then ' legal build
137.                                 If Find&(w$) Then ' check words in dictionary before add to player$
138.                                     If player$ = "" Then player$ = w$ Else player$ = player$ + " " + w$
139.                                 Else
140.                                     Beep
141.                                 End If
142.                             Else
143.                                 Sound 3000, 1
144.                             End If
145.                             w$ = ""
146.                         Case 27 'esc
147.                             w$ = "" ': exit ?
148.                         Case Else
149.                             If 63 < Asc(k$) And Asc(k$) < 91 Then w$ = w$ + k$
150.                     End Select
151.             End Select
152.         End If
153.         Locate PrintLine, 1: Print w$
154.         Locate PrintLine + 1, 1: Print player$
155.         _Display
156.         _Limit 60
157.     Wend
158.     _AutoDisplay
159.     _PrintString (400, 240), "Times up!"
160.  
161.     'lets see what the AI comes up with
162.     AI$ = AIwords$(5) ' new much larger much longer words
163.     Locate PrintLine + 8, 1: Print "AI: "; AI$
164.     Print
165.     Print "          zzz... Press any for the time of reckoning,"
166.     Print "   matching words on 2 lists will be removed and the round scored."
167.  
168.     k$ = InKey$ ' sleep aint working even with _keyclear
169.     While Len(InKey$) = 0: k$ = InKey$: _Limit 60: Wend: k$ = ""
170.     ' evalaute results (remove matching words in lists) and score
171.  
172.     Cls
173.     DisplayBoard
174.     _Font 16
175.     player$ = removeRepeats$(player$) ' remove words input 2 or more times
176.     ReDim p(1 To 1) As String 'setup to convert to an array
177.     Split player$, " ", p() ' convert player$ to array
178.     ubp = UBound(p) ' quick count of words because array is base 1
179.  
180.     ReDim a(1 To 1) As String ' likewise for AI's string list
181.     Split AI$, " ", a()
182.     uba = UBound(a)
183.  
184.     For i = 1 To uba ' Remove matching words from lists
185.         For j = 1 To ubp
186.             If a(i) = p(j) Then a(i) = "": p(j) = ""
187.         Next
188.     Next
189.     pScore = score&(p()): aiScore = score&(a()) ' scores done
190.  
191.     AI$ = "": player$ = "" ' reset strings for rebuild
192.     For i = 1 To uba ' rebuild AI's non matching words
193.         If a(i) <> "" Then AI$ = AI$ + " " + a(i)
194.     Next
195.     For i = 1 To ubp ' rebuild players non matching words (if any)
196.         If p(i) <> "" Then player$ = player$ + " " + p(i)
197.     Next
198.     'display results of reckoning for round
199.     Locate PrintLine, 1: Print "Player:"; player$; " Score:"; pScore
200.     Locate PrintLine + 8, 1: Print "AI:"; AI$; " Score:"; aiScore
201.  
202.     ' new option to lookup words!!!
203.     h_again:
204.     Print: Print "      zzz... read em and weep, press h to lookup word, any for another round "
205.     k$ = InKey$
206.     While Len(k$) = 0: k$ = InKey$: _Limit 60: Wend
207.     If k$ = "h" Then
208.         _PrintMode _FillBackground
209.         Locate PrintLine + 1, 1: Print Space$(300);
210.         Locate PrintLine + 1, 1
211.         Input "Enter word to lookup "; w$
212.         w$ = UCase$(w$)
213.         ndef = Find&(w$)
214.         If ndef Then
215.             Open "Collins Words and Defs.RA" For Random As #2 Len = 237
216.             Get #2, ndef, rec237
217.             Close #2
218.             Print rec237
219.         Else
220.             Beep
221.         End If
222.         GoTo h_again
223.     End If
224.     _PrintMode _KeepBackground
225. Loop
226.  
227. Sub NewBoard
228.     Static BeenHere, Di$(), Numbers()
229.     Dim As Long i, r, c
230.  
231.     If BeenHere = 0 Then 'load and initialize all the one time stuff
232.         ' load fonts
233.         f48 = _LoadFont("Arial.ttf", 48, "MONOSPACE")
234.         f30 = _LoadFont("Arial.ttf", 30, "MONOSPACE")
235.         If f48 <= 0 Then Print "Sub NewBoard: Font did not load, goodbye.": End
236.  
237.         'we call on this later
238.         Open "Collins_Word_List.RA" For Random As #1 Len = 15
239.  
240.         ' load dx(), dy() for testing the legality of words built from board
241.         dx(0) = -1: dy(0) = -1 ' this is for AI to find words
242.         dx(1) = 0: dy(1) = -1
243.         dx(2) = 1: dy(2) = -1
244.         dx(3) = -1: dy(3) = 0
245.         dx(4) = 1: dy(4) = 0
246.         dx(5) = -1: dy(5) = 1
247.         dx(6) = 0: dy(6) = 1
248.         dx(7) = 1: dy(7) = 1
249.  
250.         ' These are the 17 Dice with 6 Faces of a Letter need for Boggle
251.         Dim Di$(0 To 16)
252.         Di$(0) = "PACEMD"
253.         Di$(1) = "RIFOBX"
254.         Di$(2) = "IFEHEY"
255.         Di$(3) = "DENOWS"
256.         Di$(4) = "UTOKND"
257.         Di$(5) = "HMSRAO"
258.         Di$(6) = "LUPETS"
259.         Di$(7) = "ACITOA"
260.         Di$(8) = "YLGKUE"
261.         Di$(9) = "QBMJOA"
262.         Di$(10) = "EHISPN"
263.         Di$(11) = "VETIGN"
264.         Di$(12) = "BALIYT"
265.         Di$(13) = "EZAVND"
266.         Di$(14) = "RALESC"
267.         Di$(15) = "UWILRG"
268.         Di$(16) = "AEIOUU" ' b+ mod Boggle 2 to remove all special handling of Q words!!!
269.  
270.         Dim Numbers(0 To 16) ' load numbers for shuffling die order
271.         For i = 0 To 16
272.             Numbers(i) = i
273.         Next
274.         BeenHere = -1
275.     End If
276.  
277.     'now get the game going
278.     For i = 16 To 1 Step -1 'shuffle die
279.         Swap Numbers(i), Numbers(Int(Rnd * (i + 1)))
280.     Next
281.     'For i = 1 To 16: Print Numbers(i);: Next: Print   ' check the shuffle
282.     For i = 0 To 15 'choosing random face of die = 1 Letter
283.         Index2ColRow i, c, r
284.         Board$(c, r) = Mid$(Di$(Numbers(i)), Int(Rnd * 6) + 1, 1) ' one die gets is left out now Boggle 2
285.     Next
286.     ' now set timer + 180
287.     BoggleTime = Timer(.01)
288.     _Font 16
289. End Sub
290.  
291. Sub DisplayBoard
292.     Dim row, col
293.     _Font f48
294.     For row = 0 To 3 '  display the board
295.         For col = 0 To 3
296.             Line ((col + 1) * 60 - 5, (row + 1) * 60 - 5)-Step(54, 54), &HFF2020FF, BF 'face color or die
297.             Color &HFF661111 'shade
298.             _PrintString ((col + 1) * 60 + 2, (row + 1) * 60 + 2), Board$(col, row)
299.             Color &HFFBBBBBB 'letter
300.             _PrintString ((col + 1) * 60, (row + 1) * 60), Board$(col, row)
301.         Next
302.     Next
303. End Sub
304.  
305. 'might not need in final cut
306. Function ColRow2Index& (row As Long, col As Long) ' convert a board letter to index (not needed yet?)
307.     ColRow2Index& = row * 4 + col
308. End Function
309.  
310. Sub Index2ColRow (indexIn As Long, rowOut As Long, colOut As Long) 'convert die index to board col, row
311.     colOut = indexIn Mod 4: rowOut = indexIn \ 4
312. End Sub
313.  
314. Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
315.     Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
316.     curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
317.     dpos = InStr(curpos, SplitMeString, delim)
318.     Do Until dpos = 0
319.         loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
320.         arrpos = arrpos + 1
321.         If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
322.         curpos = dpos + LD
323.         dpos = InStr(curpos, SplitMeString, delim)
324.     Loop
325.     loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
326.     ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
327. End Sub
328.  
329. Function Find& (x$) ' if I am using this only to find words in dictionary, I can mod to optimize
330.     ' the RA file is opened and ready for gets
331.     Dim As Long low, hi, test
332.     Dim w$
333.     If Len(x$) < 3 Then Exit Function ' words need to be 3 letters
334.     low = 1: hi = NTopWord
335.     While low <= hi
336.         test = Int((low + hi) / 2)
337.         Get #1, test, rec15
338.         w$ = _Trim$(rec15)
339.         If w$ = x$ Then
340.             Find& = test: Exit Function
341.         Else
342.             If w$ < x$ Then low = test + 1 Else hi = test - 1
343.         End If
344.     Wend
345. End Function
346.  
347. ' This function checks to see that the word w$ is legally constructable with the given board.
348. ' This function requires the recurive Function findCell& (startX As Long, startY As Long, word$, index As Long, Arr$())
349. Function wordBuildOK& (w$)
350.     Dim As Long r, c, test
351.     Dim copy$(-1 To 4, -1 To 4), first$
352.     If Len(w$) < 3 Then Exit Function ' words need to be 3 letters
353.     For r = 0 To 3
354.         For c = 0 To 3
355.             copy$(c, r) = Board$(c, r)
356.         Next
357.     Next
358.     first$ = Mid$(w$, 1, 1)
359.     For r = 0 To 3
360.         For c = 0 To 3
361.             If copy$(c, r) = first$ Then 'cell letter matches first letter in word
362.                 test = findCell&(c, r, w$, 2, copy$())
363.                 If test Then wordBuildOK& = -1: Exit Function ' ah ha! maybe it keeps trying when we are supposed to be done, fix?
364.             End If
365.         Next
366.     Next
367. End Function
368.  
369. 'recursively called starting from wordBuildOK&
370. Function findCell& (startX As Long, startY As Long, word$, index As Long, Arr$()) ' want to setup recursive searcher
371.     Dim As Long d, x, y, i, r, c, test
372.     Dim w$
373.     'make own set of variables for this function  (attempt to debug but did not fix anything)
374.     Dim a$(-1 To 4, -1 To 4)
375.     For r = 0 To 3
376.         For c = 0 To 3
377.             a$(c, r) = Arr$(c, r)
378.         Next
379.     Next
380.     i = index: w$ = word$: y = startY: x = startX
381.     If i > Len(w$) Then findCell = -1: Exit Function
382.     a$(x, y) = "" 'so wont be used again
383.     For d = 0 To 7
384.         If a$(x + dx(d), y + dy(d)) = Mid$(w$, i, 1) Then
385.             test = findCell&(x + dx(d), y + dy(d), w$, i + 1, a$())
386.             If test Then findCell& = -1: Exit Function
387.         End If
388.     Next
389. End Function
390.  
391. Function AIwords$ (timeLimit As Double) 'returns a space delimiter string of 1 point words that can be constructed from board in limited time
392.     Dim As Double startTime, checkTime
393.     Dim As Long i, r, c, OK, dp, l
394.     Dim l$, letters$, b$, wd$
395.     startTime = Timer(.01)
396.     'ub = UBound(WordList$)  now is NTopWord
397.     ' get a non redundant list of letters from board and put them in alpha order
398.     For r = 0 To 3
399.         For c = 0 To 3
400.             l$ = Board$(c, r)
401.             If (r = 0) And (c = 0) Then
402.                 letters$ = l$
403.             Else
404.                 If InStr(letters$, l$) <= 0 Then '  insrt letter
405.                     OK = 0
406.                     For i = 1 To Len(letters$) '            where?
407.                         If Asc(l$) < Asc(letters$, i) Then ' here!
408.                             letters$ = Mid$(letters$, 1, i - 1) + l$ + Mid$(letters$, i)
409.                             OK = -1: Exit For
410.                         End If
411.                     Next
412.                     If OK = 0 Then letters$ = letters$ + l$
413.                 End If
414.             End If
415.         Next
416.     Next
417.     'check if this is OK so far  OK finally!  This is 3rd time I needed to exit when found
418.     ' AIwords$ = letters$
419.     'now letters of board are in alpha order
420.     dp = 1 'place in dict
421.     For l = 1 To Len(letters$) ' advance place in list$ by one until the word > letter
422.         Get #1, dp, rec15
423.         wd$ = _Trim$(rec15)
424.         While Asc(wd$, 1) < Asc(letters$, l)
425.             dp = dp + 1
426.             If dp > NTopWord Then GoTo fini
427.             If Timer(.01) - startTime < 0 Then checkTime = Timer(.01) + 24 * 60 * 60 Else checkTime = Timer(.01)
428.             If checkTime - startTime > timeLimit Then GoTo fini
429.             Get #1, dp, rec15
430.             wd$ = _Trim$(rec15)
431.         Wend
432.         'now start testing words
433.         While Asc(wd$, 1) = Asc(letters$, l)
434.             If wordBuildOK&(wd$) Then
435.                 If b$ = "" Then b$ = wd$ Else b$ = b$ + " " + wd$
436.             End If
437.             dp = dp + 1
438.             If dp > NTopWord Then GoTo fini
439.             If Timer(.01) - startTime < 0 Then checkTime = Timer(.01) + 24 * 60 * 60 Else checkTime = Timer(.01)
440.             If checkTime - startTime > timeLimit Then GoTo fini
441.             Get #1, dp, rec15
442.             wd$ = _Trim$(rec15)
443.         Wend
444.     Next
445.  
446.     fini:
447.     AIwords$ = b$
448. End Function
449.  
450. Function removeRepeats$ (s$) ' s$ is space delimited word list
451.     ReDim t$(1 To 1), b$
452.     Dim As Long ub, i, j, ok
453.     Split s$, " ", t$()
454.     ub = UBound(t$)
455.     For i = 1 To ub
456.         ok = -1
457.         For j = 1 To i - 1
458.             If t$(i) = t$(j) Then ok = 0: Exit For
459.         Next
460.         If ok Then
461.             If b$ = "" Then b$ = t$(i) Else b$ = b$ + " " + t$(i)
462.         End If
463.     Next
464.     removeRepeats$ = b$
465. End Function
466.  
467. Function score& (a() As String)
468.     Dim As Long i, s
469.     For i = 1 To UBound(a)
470.         Select Case Len(a(i))
471.             Case 3, 4: s = s + 1
472.             Case 5: s = s + 2
473.             Case 6: s = s + 3
474.             Case 7: s = s + 5
475.             Case Is > 7: s = s + 11
476.         End Select
477.     Next
478.     score& = s
479. End Function
480.  

Boggle 3 works zip has the 2 Collins converted files along with the Boggle 3.bas source.

Title: Re: Boggle play against AI - WIP
Post by: jack on January 16, 2022, 10:13:06 pm

the AI is not following the rules

Quote

Each player searches for words that can be constructed from the letters of sequentially adjacent cubes, where "adjacent" cubes are those horizontally, vertically, and diagonally neighboring.

looks like I need to practice, here's one online https://wordshake.com/boggle

Title: Re: Boggle play against AI - WIP
Post by: _vince on January 17, 2022, 12:32:58 am

Quote from: bplus on January 16, 2022, 12:34:16 pm

Boggle 2 update with Qwords special handling gone

BONED

Quote from: bplus on January 16, 2022, 12:34:16 pm

Boggle 2 Before Reckoning:

ANAL

Quote from: bplus on January 16, 2022, 08:51:52 pm

Solved the problem with loading all the words.

DIARREA!

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 17, 2022, 08:36:17 am

Quote from: jack on January 16, 2022, 10:13:06 pm

the AI is not following the rules looks like I need to practice, here's one online https://wordshake.com/boggle

Looks like they follow different rules for scoring, I used Wiki see first post but then I got rid of special handling of Q and   added another die to have more U's around.

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 17, 2022, 08:38:19 am

Quote from: _vince on January 17, 2022, 12:32:58 am

BONED

ANAL

DIARREA!

Not your cup of tea I take it.

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 17, 2022, 11:42:25 am

Quote from: _vince on January 17, 2022, 12:32:58 am

BONED

ANAL

DIARREA!

Internet lookup:

Quote

Did you mean: DIARRHEA

@_vince
Update: ADOLESCEN... oh hey maybe you think you can use any letter from the board at any time?
Nope, each letter must neighbor another (8 for middle square) AND no going back to a used letter for Boggle.

This is why I was so happy I could detect in code a legal build from the board. :)

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 21, 2022, 01:08:12 pm

Coming soon, Boggle Trainer:
1. Return the Q(u) die and u Insert function, remove 17th die so normal game again.
2. Keep words and points for Player, AI being perfect don't need to show.
3, Filter out all the words with () in definition that majority of people never use.
4. Fun surprise kids might like, I know I do :)

If you are playing another human in a real game and they try one of those () words, I would insist they must be able to define the word, otherwise they are just making up stuff, testing different permutations.

Title: Re: Boggle play against AI - WIP
Post by: bplus on January 21, 2022, 10:30:33 pm

I think I've got all the bugs and cleaned up:

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Boggle Trainer" ' b+ start 2022-01-12 2022-01-21 use this code as Boggle Trainer AI is too good.
3. ' It is possible to construct a word the Collins Dictionary has and AI wont show because I am not listing
4. ' exotic Dictionary words that come from Hawiaan, Shakespear, Scots, Hindi, South African, French, Latin, Tagalog,
5. ' Spencer, obsolete, Dutch, Welsh, archaic, Greek,...   all enclosed in ()'s and used as filter.
6.  
7. ' Scabble Word List and Dictionary
8. ' ref dictionary: https://boardgames.stackexchange.com/questions/38366/latest-collins-scrabble-words-list-in-text-file
9. ' Die configurations
10. ' https://boardgames.stackexchange.com/questions/29264/boggle-what-is-the-dice-configuration-for-boggle-in-various-languages
11. ' pointing finger image
12. ' http://clipart-library.com/pointing-finger-images.html
13. ' Thank you!
14.  
15. ' 2022-01-14 status have the board display separated out from New Board and Game initialization
16. ' have timer system and display working next to board display
17. ' have player input system working
18. '   1. check word in dictionary working
19. '   2. check that word can legally be built from board is funky! sometimes works sometimes not 50/50 for legit builds yuck
20. '     How to debug? Todays task is get this abolutely critical function working so the AI would be fairly easy to do.
21. ' Oh I had to modify the Collins Word list to get a size that would fit into a variable length string array, 279496 words
22. ' kept crashing QB64 without error messages when reached about 260,000 words so now I have a list for words with lengths of
23. ' between 3 and 10, still 199,651 words!
24.  
25. ' 2202-01-14 Hurray! Function wordBuildOK& is fixed, a very simple logic bug. I continued to check for builds of word after
26. ' I got confirmation one of the builds was possible. It kept checking if there was more than one place the first letter of word
27. ' appeared. The function is crucial for AI testing if words are buildable. I can get started on that today now that bug is
28. ' fixed. Man! I had this fixed almost immediately, I had to exit the Function when the recursive function findCell& called from
29. ' it found a positive result.  1/21 Yes this game rides on this function!
30.  
31. ' 2022-01-15 qw$() function to handle the Q letter, function to handle scoring, main removes matching words on the 2 lists.
32. ' you should be able to type 2 letters with (qu) square and get a 3 letter word.  1/21 This was fine fix!
33.  
34. ' 2022-01-15 screw the die with face Q(u) with implied u, adding a 17th die with AEIOUU and removing all the special handling
35. ' for that implied u crap! I don't think this will ruin the game but only make it better and less difficlut to code.
36. ' Fix the spelling of reckoning :)  OK new word files made for Boggle 2: AI Check Words is HUGE! Almost 35 X's more and longer
37. ' words, words 5 letters and longer. The Word List file has been expanded from 3 to 10 letter words to 3 to 12 letter words.
38. ' Dang! It's worse the points the AI collects from big words times the point values they are worth...
39. ' OK more handicap, AI concedes all 3-6 letters words to player and gets points only for 7+ letter words. Is it fair now?
40. ' Too much! Try concedes 3-5 but fight for 6+ letter words.  1/21 Abandoned 17th die and fixed handling of Q-words.
41.  
42. ' 2022-01-16 Yesterday I was able to use 2 large word lists from : 3 - 12 Letter Words.txt (249,702)
43. ' and AI Check Words.txt (229,745) they loaded fine all afternoon. Then I decided to use the 3-12 letter words for the
44. ' AI check words list so I only had to load one file! So I change the code to do that and suddenly the 3-12 Letter Words.txt
45. ' was quitting like there were more words than it could load (no error message, no subscript out of range you get with an array
46. ' dim'd too small for # of items to put in it), QB64 just bugged out and quit ??? Just like when I was trying to load the
47. ' whole file.   I don't like this shakey file situation, found much better method see Boggle 3.
48.  
49. ' 2022-01-16 Boggle 2 post: I will have the 3 to 10 Letter Words.txt file to load into game if you or I have problems loading the
50. ' 3 to 12 Letter Words.txt file. So just Boggle 2 and 2 word files in zip. Abandoned, one RA file now 1/21.
51.  
52. ' =================================== Sound Signals =========================================================
53. ' A high pitched squeak is a sound signalling that the word entered can't be legally built from board.
54. ' A Beep is a signal the word is not in dictionary.
55. '=============================================================================================================
56.  
57. ' 2022-01-16 Boggle 3 this may be a fork but I am going to not load the Collins word file into an array
58. ' but use an RA file I created with a bas Make code. I made the word list and the words with definitions of all words!
59. ' BTW the maxLen of a word was 15.
60. ' So first step is to convert code to this change and see how it does, will RA be too slow? We will save time
61. ' loading the file into an array but lose it throughout the game?
62. ' Hey not loading the word file(s) is working fine! AI doesn't seem to take any longer to go through the words.
63. ' Now you can lookup the words you don't know, press h for help with word after the reckoning score update.
64. ' This is not a fork but a Keeper! Love the word lookup!
65.  
66. ' 2022-01-17 Boggle 4, debating restore of special handling of Q words, adding a pointing finger for mouse pointer
67. ' 2022-01-21 Yes make this app a Boggle Trainer
68. '  1. Return the Q(u) die and u Insert function, remove 17th die so normal game again. OK done
69. '  2. Keep words and points for Player, AI being perfect don't need to show. Just relabel points as possible.
70. '  3, Filter out all the words with () in definition that majority of people never use. Done
71. '  4. Fun surprise kids might like, I know I do :)  Done
72.  
73. Randomize Timer
74. Const NTopWord = 279496
75. Const TimeLimit = 180 ' actual game time is 3 minutes = 180 secs
76. Const PrintLine = 20 ' row where I can start display of user inputs below Board display on screen.
77. Dim Shared Board$(3, 3)
78. Dim Shared As Long f48, f30, dx(7), dy(7)
79. Dim Shared As Double BoggleTime, elapsed
80. Dim Shared rec237 As String * 237 ' dictionary definitions lookup
81. Dim Shared rec15 As String * 15 ' dictionary words lookup
82.  
83. 'Main Locals
84. Dim w$, k$, player$, AI$, df$
85. Dim As Long pScore, aiScore, mx, my, mbL, mbR, row, col, pointer
86.  
87. Screen _NewImage(800, 600, 32)
88. _ScreenMove 200, 40
89. _PrintMode _KeepBackground
90. pointer = _LoadImage("point.png") ' load the "handy" pointer ha, ha
91. _ClearColor &HFF000000, pointer
92.  
93. Do
94.     Cls
95.     _MouseHide
96.     NewBoard
97.     DisplayBoard
98.     ' display timer and allow input of words from user for 3 minutes
99.     elapsed = 0: player$ = "": w$ = ""
100.     While elapsed < TimeLimit ' do stuff   <<<<<<<<<<<<<<<<<<<<<< off while debug wordBuildOK
101.         Cls
102.         DisplayBoard
103.         elapsed = Timer(.01) - BoggleTime
104.         If elapsed < 0 Then elapsed = 24 * 60 * 60 + Timer(.01) - BoggleTime ' midnight problem add aday of seconds to timer and subtr boogle
105.         _Font f48
106.         Color &HFFFFFF00
107.         _PrintString (300, 240), _Trim$(Str$(TimeLimit - Int(elapsed)))
108.  
109.         _Font 16 ' some help instructions
110.         Color _RGB32(200, 200, 255)
111.         Locate 5, 50: Print "Use Keyboard or Mouse to add letters to word."
112.         Locate 6, 50: Print " Backspace will clear last letter."
113.         Locate 7, 50: Print " Esc or Ctrl+C will clear word started."
114.         Locate 8, 50: Print " Enter or Right Mouse to checks word > list."
115.  
116.         'add mouse controls with image pointer
117.         While _MouseInput: Wend
118.         mx = _MouseX: my = _MouseY: mbL = _MouseButton(1): mbR = _MouseButton(2)
119.         _PutImage (mx - 45, my - 14)-Step(225, 225), pointer, 0
120.         row = (my - 80) / 60: col = (mx - 80) / 60 ' ?? not -60 but more
121.         If mbL Then
122.             _Delay .25
123.             If -1 < row And row < 4 Then
124.                 If -1 < col And col < 4 Then
125.                     w$ = w$ + Board$(col, row) ' add letter to w$ build
126.                 End If
127.             End If
128.         End If
129.         If mbR Then ' same as hitting Enter on keyboard
130.             _Delay .25
131.             If wordBuildOK&(w$) Then ' legal build
132.  
133.                 ' check words with or without U insertion after Q in word check word wo insertion first! so can get qat
134.                 If Find&(w$) Then ' check words in dictionary before add to player$
135.                     If player$ = "" Then player$ = w$ Else player$ = player$ + " " + w$
136.                 ElseIf Find&(qw$(w$)) Then ' check words in dictionary before add to player$
137.                     If player$ = "" Then player$ = qw$(w$) Else player$ = player$ + " " + qw$(w$)
138.                 Else
139.                     Beep
140.                 End If
141.             Else
142.                 Sound 3000, 1
143.             End If
144.             w$ = ""
145.         End If
146.  
147.         k$ = UCase$(InKey$) ' compare to all caps
148.         If Len(k$) Then 'handle 1 and 2 char key presses, maybe replace with _keyhit later
149.             Select Case Len(k$)
150.                 Case 1
151.                     Select Case Asc(k$)
152.                         Case 3 'Ctrl + C   another way to clear?
153.                             w$ = ""
154.                         Case 8 ' backspace          more to do
155.                             If Len(w$) Then w$ = Left$(w$, Len(w$) - 1)
156.                         Case 13
157.                             If wordBuildOK&(w$) Then ' legal build
158.  
159.                                 ' check words with or without U insertion after Q in word
160.                                 If Find&(w$) Then ' check words in dictionary before add to player$
161.                                     If player$ = "" Then player$ = w$ Else player$ = player$ + " " + w$
162.                                 ElseIf Find&(qw$(w$)) Then ' check words in dictionary before add to player$
163.                                     If player$ = "" Then player$ = qw$(w$) Else player$ = player$ + " " + qw$(w$)
164.                                 Else
165.                                     Beep
166.                                 End If
167.                             Else
168.                                 Sound 3000, 1
169.                             End If
170.                             w$ = ""
171.                         Case 27 'esc
172.                             w$ = "" ': exit ?
173.                         Case Else
174.                             If 63 < Asc(k$) And Asc(k$) < 91 Then w$ = w$ + k$
175.                     End Select
176.             End Select
177.         End If
178.         Locate PrintLine, 1: Print w$
179.         Locate PrintLine + 1, 1: Print player$
180.         _Display
181.         _Limit 60
182.     Wend
183.  
184.     _AutoDisplay ' reproduce the screen without the hand image
185.     _MouseShow ' this is handy for tracking words AI finds
186.     Cls
187.     DisplayBoard
188.     elapsed = Timer(.01) - BoggleTime
189.     If elapsed < 0 Then elapsed = 24 * 60 * 60 + Timer(.01) - BoggleTime ' midnight problem add aday of seconds to timer and subtr boogle
190.     _Font f48
191.     Color &HFFFFFF00
192.     _PrintString (300, 240), _Trim$(Str$(TimeLimit - Int(elapsed)))
193.     _Font f30
194.     _PrintString (400, 240), "Times up!"
195.     _Font 16
196.     Color _RGB32(200, 200, 255)
197.     Locate PrintLine + 1, 1: Print player$
198.  
199.     'lets see what the AI comes up with
200.     AI$ = AIwords$(10) ' new much larger much longer words
201.     Locate PrintLine + 8, 1: Print "AI: "; AI$
202.     Print: Print "          zzz... Press any for the time of reckoning,"
203.  
204.     _KeyClear
205.     k$ = ""
206.     k$ = InKey$ ' sleep aint working even with _keyclear
207.     While Len(InKey$) = 0: k$ = InKey$: _Limit 60: Wend: k$ = ""
208.  
209.     Cls
210.     DisplayBoard
211.     _Font 16
212.     player$ = removeRepeats$(player$) ' remove words input 2 or more times
213.     ReDim p(1 To 1) As String ' setup to score words convert to an array
214.     Split player$, " ", p() ' convert player$ to array
215.  
216.     ReDim a(1 To 1) As String ' likewise for AI's string list
217.     Split AI$, " ", a()
218.     pScore = score&(p()): aiScore = score&(a()) ' scores done
219.  
220.     'display results of reckoning for round
221.     Locate PrintLine, 1: Print "Player:";
222.     Locate PrintLine, 8: Print player$; " Score:"; pScore
223.     Locate PrintLine + 8, 1: Print "AI:";
224.     Locate PrintLine + 8, 3: Print AI$; " Common Words Available Score:"; aiScore
225.  
226.     ' new option to lookup words!!!
227.     h_again:
228.     Locate PrintLine + 5, 1: Print "      zzz... press h to lookup word, any for another round "
229.     _KeyClear
230.     k$ = ""
231.     k$ = InKey$
232.     While Len(k$) = 0: k$ = InKey$: _Limit 60: Wend
233.     If k$ = "h" Then
234.         _PrintMode _FillBackground
235.         Locate PrintLine + 1, 1: Print Space$(300);
236.         Locate PrintLine + 1, 1
237.         Input "Enter word to lookup "; w$
238.         df$ = defineWord$(w$)
239.         If df$ <> "" Then Print df$ Else Beep 'not found
240.         GoTo h_again
241.     End If
242.     _PrintMode _KeepBackground
243. Loop
244.  
245. Sub NewBoard
246.     Static BeenHere, Di$(), Numbers()
247.     Dim As Long i, r, c
248.  
249.     If BeenHere = 0 Then 'load and initialize all the one time stuff
250.         ' load fonts
251.         f48 = _LoadFont("Arial.ttf", 48, "MONOSPACE")
252.         f30 = _LoadFont("Arial.ttf", 30, "MONOSPACE")
253.         If f48 <= 0 Then Print "Sub NewBoard: Font did not load, goodbye.": End
254.  
255.         ' we call on this later
256.         Open "Collins_Word_List.RA" For Random As #1 Len = 15
257.  
258.         ' load dx(), dy() for testing the legality of words built from board
259.         dx(0) = -1: dy(0) = -1 ' this is for AI to find words
260.         dx(1) = 0: dy(1) = -1
261.         dx(2) = 1: dy(2) = -1
262.         dx(3) = -1: dy(3) = 0
263.         dx(4) = 1: dy(4) = 0
264.         dx(5) = -1: dy(5) = 1
265.         dx(6) = 0: dy(6) = 1
266.         dx(7) = 1: dy(7) = 1
267.  
268.         ' These are the 16 Dice with 6 Faces of a Letter need for Boggle back to orig version
269.         Dim Di$(0 To 15)
270.         Di$(0) = "PACEMD"
271.         Di$(1) = "RIFOBX"
272.         Di$(2) = "IFEHEY"
273.         Di$(3) = "DENOWS"
274.         Di$(4) = "UTOKND"
275.         Di$(5) = "HMSRAO"
276.         Di$(6) = "LUPETS"
277.         Di$(7) = "ACITOA"
278.         Di$(8) = "YLGKUE"
279.         Di$(9) = "QBMJOA"
280.         Di$(10) = "EHISPN"
281.         Di$(11) = "VETIGN"
282.         Di$(12) = "BALIYT"
283.         Di$(13) = "EZAVND"
284.         Di$(14) = "RALESC"
285.         Di$(15) = "UWILRG"
286.         Dim Numbers(0 To 15) ' load numbers for shuffling die order
287.         For i = 0 To 15
288.             Numbers(i) = i
289.         Next
290.         BeenHere = -1
291.     End If
292.  
293.     'now get the game going
294.     For i = 15 To 1 Step -1 'shuffle die
295.         Swap Numbers(i), Numbers(Int(Rnd * (i + 1)))
296.     Next
297.     For i = 0 To 15 'choosing random face of die = 1 Letter
298.         Index2ColRow i, c, r
299.         Board$(c, r) = Mid$(Di$(Numbers(i)), Int(Rnd * 6) + 1, 1)
300.     Next
301.     BoggleTime = Timer(.01) ' now set timer + 180
302.     _Font 16
303. End Sub
304.  
305. Sub DisplayBoard
306.     Dim row, col
307.     _Font f48
308.     For row = 0 To 3 '  display the board
309.         For col = 0 To 3
310.             Line ((col + 1) * 60 - 5, (row + 1) * 60 - 5)-Step(54, 54), &HFF2020FF, BF 'face color or die
311.             If Board$(col, row) = "Q" Then 'If face has a Q it is supposed to be "Qu"
312.                 _Font f30
313.                 Color &HFF661111 'shade
314.                 _PrintString ((col + 1) * 60 - 4, (row + 1) * 60 + 11), "Q"
315.                 _PrintString ((col + 1) * 60 + 24, (row + 1) * 60 + 11), "U"
316.                 Color &HFFBBBBBB 'letter
317.                 _PrintString ((col + 1) * 60 - 7, (row + 1) * 60 + 9), "Q"
318.                 _PrintString ((col + 1) * 60 + 22, (row + 1) * 60 + 9), "U"
319.                 _Font f48
320.             Else
321.                 Color &HFF661111 'shade
322.                 _PrintString ((col + 1) * 60 + 2, (row + 1) * 60 + 2), Board$(col, row)
323.                 Color &HFFBBBBBB 'letter
324.                 _PrintString ((col + 1) * 60, (row + 1) * 60), Board$(col, row)
325.             End If
326.         Next
327.     Next
328. End Sub
329.  
330. Sub Index2ColRow (indexIn As Long, rowOut As Long, colOut As Long) 'convert die index to board col, row
331.     colOut = indexIn Mod 4: rowOut = indexIn \ 4
332. End Sub
333.  
334. Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
335.     Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
336.     curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
337.     dpos = InStr(curpos, SplitMeString, delim)
338.     Do Until dpos = 0
339.         loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
340.         arrpos = arrpos + 1
341.         If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
342.         curpos = dpos + LD
343.         dpos = InStr(curpos, SplitMeString, delim)
344.     Loop
345.     loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
346.     ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
347. End Sub
348.  
349. Function Find& (x$) ' if I am using this only to find words in dictionary, I can mod to optimize
350.     ' the RA file is opened and ready for gets
351.     Dim As Long low, hi, test
352.     Dim w$
353.     If Len(x$) < 3 Then Exit Function ' words need to be 3 letters
354.     low = 1: hi = NTopWord
355.     While low <= hi
356.         test = Int((low + hi) / 2)
357.         Get #1, test, rec15
358.         w$ = _Trim$(rec15)
359.         If w$ = x$ Then
360.             Find& = test: Exit Function
361.         Else
362.             If w$ < x$ Then low = test + 1 Else hi = test - 1
363.         End If
364.     Wend
365. End Function
366.  
367. ' This function checks to see that the word w$ is legally constructable with the given board.
368. ' This function requires the recurive Function findCell& (startX As Long, startY As Long, word$, index As Long, Arr$())
369. Function wordBuildOK& (w$)
370.     Dim As Long r, c, test
371.     Dim copy$(-1 To 4, -1 To 4), first$
372.     If Len(w$) < 3 Then Exit Function ' words need to be 3 letters
373.     For r = 0 To 3
374.         For c = 0 To 3
375.             copy$(c, r) = Board$(c, r)
376.         Next
377.     Next
378.     first$ = Mid$(w$, 1, 1)
379.     For r = 0 To 3
380.         For c = 0 To 3
381.             If copy$(c, r) = first$ Then 'cell letter matches first letter in word
382.                 test = findCell&(c, r, w$, 2, copy$())
383.                 If test Then wordBuildOK& = -1: Exit Function ' ah ha! maybe it keeps trying when we are supposed to be done, fix?
384.             End If
385.         Next
386.     Next
387. End Function
388.  
389. 'recursively called starting from wordBuildOK&
390. Function findCell& (startX As Long, startY As Long, word$, index As Long, Arr$()) ' want to setup recursive searcher
391.     Dim As Long d, x, y, i, r, c, test
392.     Dim w$
393.     'make own set of variables for this function  (attempt to debug but did not fix anything)
394.     Dim a$(-1 To 4, -1 To 4)
395.     For r = 0 To 3
396.         For c = 0 To 3
397.             a$(c, r) = Arr$(c, r)
398.         Next
399.     Next
400.     i = index: w$ = word$: y = startY: x = startX
401.     If i > Len(w$) Then findCell = -1: Exit Function
402.     a$(x, y) = "" 'so wont be used again
403.     For d = 0 To 7
404.         If a$(x + dx(d), y + dy(d)) = Mid$(w$, i, 1) Then
405.             test = findCell&(x + dx(d), y + dy(d), w$, i + 1, a$())
406.             If test Then findCell& = -1: Exit Function
407.         End If
408.     Next
409. End Function
410.  
411. Function AIwords$ (timeLimit As Double) 'returns a space delimiter string of 1 point words that can be constructed from board in limited time
412.     Dim As Double startTime, checkTime
413.     Dim As Long i, r, c, OK, dp, l
414.     Dim l$, letters$, b$, wd$
415.     startTime = Timer(.01)
416.     ' get a non redundant list of letters from board and put them in alpha order
417.     For r = 0 To 3
418.         For c = 0 To 3
419.             l$ = Board$(c, r)
420.             If (r = 0) And (c = 0) Then
421.                 letters$ = l$
422.             Else
423.                 If InStr(letters$, l$) <= 0 Then '  insrt letter
424.                     OK = 0
425.                     For i = 1 To Len(letters$) '            where?
426.                         If Asc(l$) < Asc(letters$, i) Then ' here!
427.                             letters$ = Mid$(letters$, 1, i - 1) + l$ + Mid$(letters$, i)
428.                             OK = -1: Exit For
429.                         End If
430.                     Next
431.                     If OK = 0 Then letters$ = letters$ + l$
432.                 End If
433.             End If
434.         Next
435.     Next
436.     'now letters of board are in alpha order
437.     dp = 1 'place in dict
438.     For l = 1 To Len(letters$) ' advance place in list$ by one until the word > letter
439.         Get #1, dp, rec15
440.         wd$ = _Trim$(rec15)
441.         While Asc(wd$, 1) < Asc(letters$, l)
442.             dp = dp + 1
443.             If dp > NTopWord Then GoTo fini
444.             If Timer(.01) - startTime < 0 Then checkTime = Timer(.01) + 24 * 60 * 60 Else checkTime = Timer(.01)
445.             If checkTime - startTime > timeLimit Then GoTo fini
446.             Get #1, dp, rec15
447.             wd$ = _Trim$(rec15)
448.         Wend
449.         'now start testing words
450.         While Asc(wd$, 1) = Asc(letters$, l)
451.             If wordBuildOK&(wd$) Then
452.                 If InStr(defineWord$(wd$), "(") <= 0 Then ' no () else its an exotic word
453.                     If b$ = "" Then b$ = wd$ Else b$ = b$ + " " + wd$
454.                 ElseIf InStr(defineWord$(qw$(wd$)), "(") <= 0 Then ' check u insert for q word too
455.                     If b$ = "" Then b$ = qw$(wd$) Else b$ = b$ + " " + qw$(wd$)
456.                 End If
457.             End If
458.             dp = dp + 1
459.             If dp > NTopWord Then GoTo fini
460.             If Timer(.01) - startTime < 0 Then checkTime = Timer(.01) + 24 * 60 * 60 Else checkTime = Timer(.01)
461.             If checkTime - startTime > timeLimit Then GoTo fini
462.             Get #1, dp, rec15
463.             wd$ = _Trim$(rec15)
464.         Wend
465.     Next
466.  
467.     fini:
468.     AIwords$ = b$
469. End Function
470.  
471. Function qw$ (w$) 'insert the u into a q letter word
472.     Dim As Long p
473.     p = InStr(w$, "Q")
474.     If p Then qw$ = Mid$(w$, 1, p) + "U" + Mid$(w$, p + 1) Else qw$ = w$
475. End Function
476.  
477. Function removeRepeats$ (s$) ' s$ is space delimited word list
478.     ReDim t$(1 To 1), b$
479.     Dim As Long ub, i, j, ok
480.     Split s$, " ", t$()
481.     ub = UBound(t$)
482.     For i = 1 To ub
483.         ok = -1
484.         For j = 1 To i - 1
485.             If t$(i) = t$(j) Then ok = 0: Exit For
486.         Next
487.         If ok Then
488.             If b$ = "" Then b$ = t$(i) Else b$ = b$ + " " + t$(i)
489.         End If
490.     Next
491.     removeRepeats$ = b$
492. End Function
493.  
494. Function score& (a() As String)
495.     Dim As Long i, s
496.     For i = 1 To UBound(a)
497.         Select Case Len(a(i))
498.             Case 3, 4: s = s + 1
499.             Case 5: s = s + 2
500.             Case 6: s = s + 3
501.             Case 7: s = s + 5
502.             Case Is > 7: s = s + 11
503.         End Select
504.     Next
505.     score& = s
506. End Function
507.  
508. Function defineWord$ (w$) ' this will not edit out definitions that have () in them
509.     Dim nDef As Long
510.     w$ = UCase$(w$)
511.     nDef = Find&(w$)
512.     If nDef Then
513.         Open "Collins Words and Defs.RA" For Random As #2 Len = 237
514.         Get #2, nDef, rec237
515.         Close #2
516.     End If
517.     defineWord$ = _Trim$(rec237)
518. End Function
519.  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Zip with dictionary, wordlist, pointer image and bas source:

Title: Re: Boggle play against AI - WIP
Post by: _vince on January 22, 2022, 12:03:41 am

Quote from: bplus on January 21, 2022, 10:30:33 pm

I think I've got all the bugs and cleaned up:

NICE LOLLIPOP!

Text Only | Text with Attachments