### Author Topic: Boggle play against AI - WIP  (Read 558 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

#### bplus

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

#### bplus

• Forum Resident
• Posts: 7653
• b = b + ...
##### Re: Boggle play against AI - WIP
« Reply #1 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

#### bplus

• Forum Resident
• Posts: 7653
• b = b + ...
##### Re: Boggle play against AI - WIP
« Reply #2 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?
« Last Edit: January 14, 2022, 08:30:03 am by bplus »

#### bplus

• Forum Resident
• Posts: 7653
• b = b + ...
##### Re: Boggle play against AI - WIP
« Reply #3 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.
« Last Edit: January 14, 2022, 10:23:09 am by bplus »

#### bplus

• Forum Resident
• Posts: 7653
• b = b + ...
##### Re: Boggle play against AI - WIP
« Reply #4 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:

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

#### Statsman1

• Newbie
• Posts: 36
• I'm just a jerk, but a hero is what I want to be.
##### Re: Boggle play against AI - WIP
« Reply #5 on: January 14, 2022, 01:05:31 pm »
@bplus - Dude, you are on FIRE.  Fantastic stuff so quickly!
Good decisions come from experience.

#### bplus

• Forum Resident
• Posts: 7653
• b = b + ...
##### Re: Boggle play against AI - WIP
« Reply #6 on: January 14, 2022, 03:15:20 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.

#### Statsman1

• Newbie
• Posts: 36
• I'm just a jerk, but a hero is what I want to be.
##### Re: Boggle play against AI - WIP
« Reply #7 on: January 14, 2022, 03:39:49 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.
Good decisions come from experience.

#### bplus

• Forum Resident
• Posts: 7653
• b = b + ...
##### Re: Boggle play against AI - WIP
« Reply #8 on: January 14, 2022, 03:51:41 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.

#### bplus

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

Dang, I missed god.

#### SMcNeill

• QB64 Developer
• Forum Resident
• Posts: 3786
##### Re: Boggle play against AI - WIP
« Reply #10 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.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

#### bplus

• Forum Resident
• Posts: 7653
• b = b + ...
##### Re: Boggle play against AI - WIP
« Reply #11 on: January 15, 2022, 01:56:51 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.
« Last Edit: January 15, 2022, 02:03:44 pm by bplus »

#### jack

• Seasoned Forum Regular
• Posts: 382
##### Re: Boggle play against AI - WIP
« Reply #12 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" ?

#### bplus

• Forum Resident
• Posts: 7653
• b = b + ...
##### Re: Boggle play against AI - WIP
« Reply #13 on: January 15, 2022, 03:22:33 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.
« Last Edit: January 15, 2022, 03:37:41 pm by bplus »

#### SMcNeill

• QB64 Developer
• Forum Resident
• Posts: 3786
##### Re: Boggle play against AI - WIP
« Reply #14 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.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!