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

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Boggle play against AI - WIP
« Reply #15 on: January 16, 2022, 08:46:04 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.

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Boggle play against AI - WIP
« Reply #16 on: January 16, 2022, 12:33:02 pm »
bplus is into letters now instead of graphics, sad times

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Boggle play against AI - WIP
« Reply #17 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. _Title "Boggle 2" ' 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. ' 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
  27. ' for that implied u crap! I don't think this will ruin the game but only make it better and less difficlut to code.
  28. ' 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
  29. ' 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.
  30. ' Dang! It's worse the points the AI collects from big words times the point values they are worth...
  31. ' OK more handicap, AI concedes all 3-6 letters words to player and gets points only for 7+ letter words. Is it fair now?
  32. ' Too much! Try concedes 3-5 but fight for 6+ letter words.
  33.  
  34. ' 2022-01-16 Yesterday I was able to use 2 large word lists from : 3 - 12 Letter Words.txt (249,702)
  35. ' and AI Check Words.txt (229,745) they loaded fine all afternoon. Then I decided to use the 3-12 letter words for the
  36. ' 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
  37. ' was quitting like there were more words than it could load (no error message, no subscript out of range you get with an array
  38. ' 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
  39. ' whole file.
  40. '    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
  41. ' variable NTopWord. And I am going to try and load a bigger 3-16 Letter Words.txt file. NOPE!
  42. ' 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.
  43. ' Try loading up Browser and run other stuff, maybe QB64 variable length string loads in one array is limited. Still OK.
  44. ' Have no idea why it works for .5 day and later doesn't ????
  45.  
  46. ' 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
  47. ' 3 to 12 Letter Words.txt file. So just Boggle 2 and 2 word files in zip.
  48.  
  49. '  =================================== Sound Signals =========================================================
  50. ' Oh a high pitched peep is a sound signalling that the word enetered can't be legally built from board.
  51. ' A Beep is a signal the word is not in dictionary.
  52.  
  53. Const TimeLimit = 180 ' actual game time is 3 minutes = 180 secs
  54. Const PrintLine = 20 ' row where I can start display of user inputs below Board display on screen.
  55. Dim Shared Board$(3, 3), WordList$(1 To 280000) ' < this is over sized array # words is 279369 try jacks idea of oversized array
  56. Dim Shared As Long f48, f30, dx(7), dy(7), NTopWord
  57. Dim Shared As Double BoggleTime, elapsed
  58. Dim w$, k$, player$, AI$
  59. Dim As Long pScore, aiScore, uba, ubp, i, j, mx, my, mbL, mbR, row, col
  60. Screen _NewImage(800, 600, 32)
  61. _ScreenMove 200, 100
  62.  
  63. ' quick board for testin working mouse locations for clicking letters
  64. 'NewBoard
  65. 'While _KeyDown(27) = 0
  66. '    Cls
  67. '    DisplayBoard
  68. '    _Font 16
  69. '    While _MouseInput: Wend
  70. '    mx = _MouseX: my = _MouseY: mbL = _MouseButton(1): mbR = _MouseButton(2)
  71. '    row = (my - 80) / 60: col = (mx - 80) / 60 ' ?? not -60 but more
  72. '    Print col, row, mbL, mbR
  73. '    _Display
  74. '    _Limit 60
  75. 'Wend
  76.  
  77.     NewBoard ' display timer and allow input of words from user for 3 minutes
  78.     DisplayBoard
  79.     elapsed = 0: player$ = "": w$ = ""
  80.     While elapsed < TimeLimit ' do stuff   <<<<<<<<<<<<<<<<<<<<<< off while debug wordBuildOK
  81.         Cls
  82.         DisplayBoard
  83.         elapsed = Timer(.01) - BoggleTime
  84.         If elapsed < 0 Then elapsed = 24 * 60 * 60 + Timer(.01) - BoggleTime ' midnight problem add aday of seconds to timer and subtr boogle
  85.         _Font f48
  86.         Color &HFFFFFF00
  87.         _PrintString (300, 240), _Trim$(Str$(TimeLimit - Int(elapsed)))
  88.  
  89.         _Font 16
  90.         Color _RGB32(200, 200, 255)
  91.  
  92.         'some help
  93.         Locate 5, 50: Print "Use Keyboard or Mouse to add letters to word."
  94.         Locate 6, 50: Print " Backspace will clear last letter."
  95.         Locate 7, 50: Print " Esc or Ctrl+C will clear word started."
  96.         Locate 8, 50: Print " Enter or Right Mouse to checks word > list."
  97.  
  98.         'add mouse controls
  99.         While _MouseInput: Wend
  100.         mx = _MouseX: my = _MouseY: mbL = _MouseButton(1): mbR = _MouseButton(2)
  101.         row = (my - 80) / 60: col = (mx - 80) / 60 ' ?? not -60 but more
  102.         If mbL Then
  103.             _Delay .25
  104.             If -1 < row And row < 4 Then
  105.                 If -1 < col And col < 4 Then
  106.                     w$ = w$ + Board$(col, row) ' add letter to w$ build
  107.                 End If
  108.             End If
  109.         End If
  110.         If mbR Then ' same as hitting Enter on keyboard
  111.             _Delay .25
  112.             If wordBuildOK&(w$) Then ' legal build
  113.                 If Find&(WordList$(), w$) Then ' check words in dictionary before add to player$
  114.                     If player$ = "" Then player$ = w$ Else player$ = player$ + " " + w$
  115.                 Else
  116.                     Beep
  117.                 End If
  118.             Else
  119.                 Sound 3000, 1
  120.             End If
  121.             w$ = ""
  122.         End If
  123.  
  124.         k$ = UCase$(InKey$) ' compare to all caps
  125.         If Len(k$) Then 'handle 1 and 2 char key presses, maybe replace with _keyhit later
  126.             Select Case Len(k$)
  127.                 Case 1
  128.                     Select Case Asc(k$)
  129.                         Case 3 'Ctrl + C   another way to clear?
  130.                             w$ = ""
  131.                         Case 8 ' backspace          more to do
  132.                             If Len(w$) Then w$ = Left$(w$, Len(w$) - 1)
  133.                         Case 13
  134.                             If wordBuildOK&(w$) Then ' legal build
  135.                                 If Find&(WordList$(), w$) Then ' check words in dictionary before add to player$
  136.                                     If player$ = "" Then player$ = w$ Else player$ = player$ + " " + w$
  137.                                 Else
  138.                                     Beep
  139.                                 End If
  140.                             Else
  141.                                 Sound 3000, 1
  142.                             End If
  143.                             w$ = ""
  144.                         Case 27 'esc
  145.                             w$ = "" ': exit ?
  146.                         Case Else
  147.                             If 63 < Asc(k$) And Asc(k$) < 91 Then w$ = w$ + k$
  148.                     End Select
  149.             End Select
  150.         End If
  151.         Locate PrintLine, 1: Print w$
  152.         Locate PrintLine + 1, 1: Print player$
  153.         _Display
  154.         _Limit 60
  155.     Wend
  156.     _PrintString (400, 240), "Times up!"
  157.  
  158.     'lets see what the AI comes up with
  159.     AI$ = AIwords$(5) ' new much larger much longer words
  160.     Locate PrintLine + 4, 1: Print "AI: "; AI$
  161.     Print "          zzz... Press any for the time of reckoning,"
  162.     Print "   matching words on 2 lists will be removed and the round scored."
  163.     Sleep
  164.     ' evalaute results (remove matching words in lists) and score
  165.     Cls
  166.     DisplayBoard
  167.     _Font 16
  168.     player$ = removeRepeats$(player$) ' remove words input 2 or more times
  169.     ReDim p(1 To 1) As String 'setup to convert to an array
  170.     Split player$, " ", p() ' convert player$ to array
  171.     ubp = UBound(p) ' quick count of words because array is base 1
  172.  
  173.     ReDim a(1 To 1) As String ' likewise for AI's string list
  174.     Split AI$, " ", a()
  175.     uba = UBound(a)
  176.  
  177.     For i = 1 To uba ' Remove matching words from lists
  178.         For j = 1 To ubp
  179.             If a(i) = p(j) Then a(i) = "": p(j) = ""
  180.         Next
  181.     Next
  182.     pScore = score&(p()): aiScore = score&(a()) ' scores done
  183.  
  184.     AI$ = "": player$ = "" ' reset strings for rebuild
  185.     For i = 1 To uba ' rebuild AI's non matching words
  186.         If a(i) <> "" Then AI$ = AI$ + " " + a(i)
  187.     Next
  188.     For i = 1 To ubp ' rebuild players non matching words (if any)
  189.         If p(i) <> "" Then player$ = player$ + " " + p(i)
  190.     Next
  191.     'display results of reckoning for round
  192.     Locate PrintLine, 1: Print "Player:"; player$; " Score:"; pScore
  193.     Locate PrintLine + 3, 1: Print "AI:"; AI$; " Score:"; aiScore
  194.     Print "      zzz... read em and weep, press any for another round of humiliation :)"
  195.     Sleep
  196.  
  197. Sub NewBoard
  198.     Static BeenHere, Di$(), Numbers()
  199.     Dim As Long i, r, c
  200.  
  201.     If BeenHere = 0 Then 'load and initialize all the one time stuff
  202.         ' load fonts
  203.         f48 = _LoadFont("Arial.ttf", 48, "MONOSPACE")
  204.         f30 = _LoadFont("Arial.ttf", 30, "MONOSPACE")
  205.         If f48 <= 0 Then Print "Sub NewBoard: Font did not load, goodbye.": End
  206.  
  207.         'load abrev Dictionary ======================================== comment out while debug
  208.         Open "3 to 12 Letter Words.txt" For Input As #1 ' for some reason 3-12 stopped loading on me
  209.         '  "3 to 16 Letter Words.txt" new bigger file than loaded
  210.         ' jack idea didn't work
  211.         ' lets see if 3 to 12 will load this morning, yes it's loading this morning (Browser off)
  212.  
  213.         Print "Loading 3 to 12 Letter Words from Collins Dictionary..."
  214.         While Not EOF(1)
  215.             i = i + 1
  216.             Input #1, WordList$(i)
  217.             'Cls: Locate 2, 1: Print i
  218.         Wend
  219.         Close #1
  220.         NTopWord = i
  221.         Print "Big Word File loaded!,"; NTopWord; " items   zzz..."
  222.         Sleep
  223.  
  224.         ' test load of file, find last 10 items
  225.         'For i = 199651 - 10 To 199651  ' when testing 3 to 10 Letter Words.txt
  226.         '    Print WordList$(i)
  227.         'Next
  228.         'Sleep    OK loading
  229.  
  230.         ' When using a separate word file for AI to "Handicap" it, no good just adds time to load stuff
  231.         'Open "AI Check Words.txt" For Input As #1
  232.         'Print "Loading AI Check Words.txt for AI, 6 to 12 letter words same dictionary..."
  233.         'i = 0
  234.         'While Not EOF(1)
  235.         '    i = i + 1
  236.         '    Input #1, AICheckWords$(i)
  237.         'Wend
  238.         'Close #1
  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.  
  290. Sub DisplayBoard
  291.     Dim row, col
  292.     _Font f48
  293.     For row = 0 To 3 '  display the board
  294.         For col = 0 To 3
  295.             Line ((col + 1) * 60 - 5, (row + 1) * 60 - 5)-Step(54, 54), &HFF2020FF, BF 'face color or die
  296.             Color &HFF661111 'shade
  297.             _PrintString ((col + 1) * 60 + 2, (row + 1) * 60 + 2), Board$(col, row)
  298.             Color &HFFBBBBBB 'letter
  299.             _PrintString ((col + 1) * 60, (row + 1) * 60), Board$(col, row)
  300.         Next
  301.     Next
  302.  
  303. 'might not need in final cut
  304. Function ColRow2Index& (row As Long, col As Long) ' convert a board letter to index (not needed yet?)
  305.     ColRow2Index& = row * 4 + col
  306.  
  307. Sub Index2ColRow (indexIn As Long, rowOut As Long, colOut As Long) 'convert die index to board col, row
  308.     colOut = indexIn Mod 4: rowOut = indexIn \ 4
  309.  
  310. Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
  311.     Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
  312.     curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
  313.     dpos = InStr(curpos, SplitMeString, delim)
  314.     Do Until dpos = 0
  315.         loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
  316.         arrpos = arrpos + 1
  317.         If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
  318.         curpos = dpos + LD
  319.         dpos = InStr(curpos, SplitMeString, delim)
  320.     Loop
  321.     loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
  322.     ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
  323.  
  324. Function Find& (SortedArr$(), x$) ' if I am using this only to find words in dictionary, I can mod to optimize
  325.     Dim As Long low, hi, test
  326.     low = LBound(SortedArr$): hi = UBound(SortedArr$)
  327.     While low <= hi
  328.         test = Int((low + hi) / 2)
  329.         If SortedArr$(test) = x$ Then
  330.             Find& = test: Exit Function
  331.         Else
  332.             If SortedArr$(test) < x$ Then low = test + 1 Else hi = test - 1
  333.         End If
  334.     Wend
  335.  
  336. ' This function checks to see that the word w$ is legally constructable with the given board.
  337. ' This function requires the recurive Function findCell& (startX As Long, startY As Long, word$, index As Long, Arr$())
  338. Function wordBuildOK& (w$)
  339.     Dim As Long r, c, test
  340.     Dim copy$(-1 To 4, -1 To 4), first$
  341.     For r = 0 To 3
  342.         For c = 0 To 3
  343.             copy$(c, r) = Board$(c, r)
  344.         Next
  345.     Next
  346.     first$ = Mid$(w$, 1, 1)
  347.     For r = 0 To 3
  348.         For c = 0 To 3
  349.             If copy$(c, r) = first$ Then 'cell letter matches first letter in word
  350.                 test = findCell&(c, r, w$, 2, copy$())
  351.                 If test Then wordBuildOK& = -1: Exit Function ' ah ha! maybe it keeps trying when we are supposed to be done, fix?
  352.             End If
  353.         Next
  354.     Next
  355.  
  356. 'recursively called starting from wordBuildOK&
  357. Function findCell& (startX As Long, startY As Long, word$, index As Long, Arr$()) ' want to setup recursive searcher
  358.     Dim As Long d, x, y, i, r, c, test
  359.     Dim w$
  360.     'make own set of variables for this function  (attempt to debug but did not fix anything)
  361.     Dim a$(-1 To 4, -1 To 4)
  362.     For r = 0 To 3
  363.         For c = 0 To 3
  364.             a$(c, r) = Arr$(c, r)
  365.         Next
  366.     Next
  367.     i = index: w$ = word$: y = startY: x = startX
  368.     If i > Len(w$) Then findCell = -1: Exit Function
  369.     a$(x, y) = "" 'so wont be used again
  370.     For d = 0 To 7
  371.         If a$(x + dx(d), y + dy(d)) = Mid$(w$, i, 1) Then
  372.             test = findCell&(x + dx(d), y + dy(d), w$, i + 1, a$())
  373.             If test Then findCell& = -1: Exit Function
  374.         End If
  375.     Next
  376.  
  377. Function AIwords$ (timeLimit As Double) 'returns a space delimiter string of 1 point words that can be constructed from board in limited time
  378.     Dim As Double startTime, checkTime
  379.     Dim As Long i, r, c, OK, dp, l
  380.     Dim l$, letters$, b$
  381.     startTime = Timer(.01)
  382.     'ub = UBound(WordList$)  now is NTopWord
  383.     ' get a non redundant list of letters from board and put them in alpha order
  384.     For r = 0 To 3
  385.         For c = 0 To 3
  386.             l$ = Board$(c, r)
  387.             If (r = 0) And (c = 0) Then
  388.                 letters$ = l$
  389.             Else
  390.                 If InStr(letters$, l$) <= 0 Then '  insrt letter
  391.                     OK = 0
  392.                     For i = 1 To Len(letters$) '            where?
  393.                         If Asc(l$) < Asc(letters$, i) Then ' here!
  394.                             letters$ = Mid$(letters$, 1, i - 1) + l$ + Mid$(letters$, i)
  395.                             OK = -1: Exit For
  396.                         End If
  397.                     Next
  398.                     If OK = 0 Then letters$ = letters$ + l$
  399.                 End If
  400.             End If
  401.         Next
  402.     Next
  403.     'check if this is OK so far  OK finally!  This is 3rd time I needed to exit when found
  404.     ' AIwords$ = letters$
  405.     'now letters of board are in alpha order
  406.     dp = 1 'place in dict
  407.     For l = 1 To Len(letters$) ' advance place in list$ by one until the word > letter
  408.         While Asc(WordList$(dp), 1) < Asc(letters$, l)
  409.             dp = dp + 1
  410.             If dp > NTopWord Then GoTo fini
  411.             If Timer(.01) - startTime < 0 Then checkTime = Timer(.01) + 24 * 60 * 60 Else checkTime = Timer(.01)
  412.             If checkTime - startTime > timeLimit Then GoTo fini
  413.         Wend
  414.         'now start testing words
  415.         While Asc(WordList$(dp), 1) = Asc(letters$, l)
  416.             If wordBuildOK&(WordList$(dp)) Then
  417.                 If b$ = "" Then b$ = WordList$(dp) Else b$ = b$ + " " + WordList$(dp)
  418.             End If
  419.             dp = dp + 1
  420.             If dp > NTopWord Then GoTo fini
  421.             If Timer(.01) - startTime < 0 Then checkTime = Timer(.01) + 24 * 60 * 60 Else checkTime = Timer(.01)
  422.             If checkTime - startTime > timeLimit Then GoTo fini
  423.         Wend
  424.     Next
  425.  
  426.     fini:
  427.     AIwords$ = b$
  428.  
  429. ' Dont need to special handling of Q words
  430. 'Function qw$ (w$) 'insert the u into a q letter word
  431. '    Dim As Long p
  432. '    p = InStr(w$, "Q")
  433. '    If p Then qw$ = Mid$(w$, 1, p) + "U" + Mid$(w$, p + 1) Else qw$ = w$
  434. 'End Function
  435.  
  436. Function removeRepeats$ (s$) ' s$ is space delimited word list
  437.     ReDim t$(1 To 1), b$
  438.     Dim As Long ub, i, j, ok
  439.     Split s$, " ", t$()
  440.     ub = UBound(t$)
  441.     For i = 1 To ub
  442.         ok = -1
  443.         For j = 1 To i - 1
  444.             If t$(i) = t$(j) Then ok = 0: Exit For
  445.         Next
  446.         If ok Then
  447.             If b$ = "" Then b$ = t$(i) Else b$ = b$ + " " + t$(i)
  448.         End If
  449.     Next
  450.     removeRepeats$ = b$
  451.  
  452. Function score& (a() As String)
  453.     Dim As Long i, s
  454.     For i = 1 To UBound(a)
  455.         Select Case Len(a(i))
  456.             Case 3, 4: s = s + 1
  457.             Case 5: s = s + 2
  458.             Case 6: s = s + 3
  459.             Case 7: s = s + 5
  460.             Case Is > 7: s = s + 11
  461.         End Select
  462.     Next
  463.     score& = s
  464.  

Boggle 2 Before Reckoning:
 
boggle 2 before reckoning.PNG


Boggle 2 Post Reckoning:
 
Boggle 2 post reckoning.PNG


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.

* Boggle 2 bas and 2 files.zip (Filesize: 1.1 MB, Downloads: 184)
« Last Edit: January 16, 2022, 12:52:39 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Boggle play against AI - WIP
« Reply #18 on: January 16, 2022, 12:39:49 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!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Boggle play against AI - WIP
« Reply #19 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.
 
Boggle 3.PNG


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

Boggle 3 works zip has the 2 Collins converted files along with the Boggle 3.bas source.
* Boggle 3 works.zip (Filesize: 5.44 MB, Downloads: 159)

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: Boggle play against AI - WIP
« Reply #20 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
« Last Edit: January 16, 2022, 10:42:36 pm by jack »

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Boggle play against AI - WIP
« Reply #21 on: January 17, 2022, 12:32:58 am »
Boggle 2 update with Qwords special handling gone

BONED

Boggle 2 Before Reckoning:

ANAL

Solved the problem with loading all the words.

DIARREA!




Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Boggle play against AI - WIP
« Reply #22 on: January 17, 2022, 08:36:17 am »
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.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Boggle play against AI - WIP
« Reply #23 on: January 17, 2022, 08:38:19 am »
BONED

ANAL

DIARREA!

Not your cup of tea I take it.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Boggle play against AI - WIP
« Reply #24 on: January 17, 2022, 11:42:25 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. :)

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Boggle play against AI - WIP
« Reply #25 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.
« Last Edit: January 21, 2022, 01:18:23 pm by bplus »

Marked as best answer by bplus on January 21, 2022, 05:45:41 pm

Offline bplus

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

 
Boggle 4 Trainer.PNG


Zip with dictionary, wordlist, pointer image and bas source:
* Boggle 4 Trainer.zip (Filesize: 5.45 MB, Downloads: 151)

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Boggle play against AI - WIP
« Reply #27 on: January 22, 2022, 12:03:41 am »
I think I've got all the bugs and cleaned up:

NICE LOLLIPOP!