|
Post by anthonyrbrown on Feb 13, 2024 21:24:58 GMT
|
|
|
Post by bplus on Feb 13, 2024 22:35:15 GMT
ARB, once again you post very interesting links!
I am going to take another shot tonight with my own MiniMax version of TTT from scratch. I should be able to get this unless I am getting really old!
If that doesn't pan out, then I am sure I will be ready to read what other people have to say on the problem.
I wonder if Rosetta Code has anything on this. It would be an excellent challenge to do,
|
|
|
Post by bplus on Feb 13, 2024 22:42:41 GMT
update: I did a search on MiniMax at Rosetta and it took me straight to TTT but I don't see where Minimax was used in the description of the challenge.
|
|
|
Post by anthonyrbrown on Feb 14, 2024 0:12:31 GMT
|
|
|
Post by bplus on Feb 14, 2024 1:51:45 GMT
Oh crap the evaluate%() function in the first translation had a logic bug, that thows off everthing tested with it!
Quiz: find that logic flaw in evaluate%().
|
|
|
Post by bplus on Feb 14, 2024 9:17:55 GMT
OK I got the TTT code to solve immediate wins and spoilers to prevent opponent from winning on next move but I only have two boards that actually test MiniMax! which for some reason sucks with immediate wins and spoilers.
So if ARB or anyone can give me a few challenging board setups for me to test, I will.
|
|
|
Post by anthonyrbrown on Feb 14, 2024 11:07:36 GMT
I have everything you need here bplus with all the Test positions! How to Win at Tic-Tac-Toe By Ryan Aycock Copyright 2002 www.ryanaycock.com/ttt.pdf
|
|
|
Post by bplus on Feb 14, 2024 14:48:37 GMT
OK that underlined sentence tells me that the Minimax is still probably not correct.
I tested it with top right corner, and it doesn't say the best move for o is the center.
TTT minimax 3
Option _Explicit _Title "TTT minimax 3" ' b+ 2024-02-14
Dim Shared P$(1), debug P$(0) = "o": P$(1) = "x": debug = 0 ' x plays on moves 1, 3, 5, 7, 9 ' 0 plays on moves 2, 4, 6, 8 ' the number of spaces left mod 2 says x or o eg 9 spaces = x move
' in this main part we just setup a board and and call FindBestMove that answers Dim board$(2, 2), i As Integer, j As Integer
' original board from translation 'board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "x" 'board$(1, 0) = "o": board$(1, 1) = "o": board$(1, 2) = "x" 'board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' best 2,2 obviously immediate win yep!
' test some more boards 'board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "x" 'board$(1, 0) = "o": board$(1, 1) = "o": board$(1, 2) = "_" 'board$(2, 0) = "x": board$(2, 1) = "_": board$(2, 2) = "_" ' best 1, 2 to block o from winning Good!
' test some more boards try uneven x, so o goes first 'board$(0, 0) = "o": board$(0, 1) = "x": board$(0, 2) = "o" 'board$(1, 0) = "_": board$(1, 1) = "x": board$(1, 2) = "_" 'board$(2, 0) = "x": board$(2, 1) = "_": board$(2, 2) = "_" ' 2, 1 o moves and must block x win fixed!!! yea!
' another immediate win check 'board$(0, 0) = "x": board$(0, 1) = "_": board$(0, 2) = "_" 'board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" 'board$(2, 0) = "x": board$(2, 1) = "_": board$(2, 2) = "o" ' best is 1, 0 yes! row 1, col 0 ??? fixed !!! yea!
' crap still off 2024-02-12 FIXED at 12:53 recheck other boards 'board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "_" 'board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" 'board$(2, 0) = "_": board$(2, 1) = "x": board$(2, 2) = "_" ' best is 2, 0 yes! it's saying 2, 0, nice!
' test some more boards best move to start? 'board$(0, 0) = "_": board$(0, 1) = "_": board$(0, 2) = "_" 'board$(1, 0) = "_": board$(1, 1) = "_": board$(1, 2) = "_" 'board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' 1, 1 middle is my guess! ' 0, 0 ??? still ' but a tie might be achieved from any position or any corner?
' after first corner move? board$(0, 0) = "x": board$(0, 1) = "_": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "_": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' 0, 1 not 1, 1 hmmm ?
'show the board we are talking about For i = 0 To 2: For j = 0 To 2: Print board$(i, j);: Next: Print: Next findBestMove board$() ' this sub print best move and we are done
Sub findBestMove (board$()) Dim As Integer i, j, spaces, bestVal, bestRow, bestCol, moveVal Dim player$ For i = 0 To 2: For j = 0 To 2 ' count spaces left on board If board$(i, j) = "_" Then spaces = spaces + 1 Next j, i If isWin%(board$()) = 0 And spaces > 0 Then ' not done! player$ = P$(spaces Mod 2): bestVal = -1000: bestRow = -1: bestCol = -1 For i = 0 To 2: For j = 0 To 2 ' look for an immediate win If board$(i, j) = "_" Then board$(i, j) = player$ If isWin%(board$()) Then 'have to do this now to check for spoiler next Print player$; " Best row:"; i; " Best col:"; j; " value was: "; "Immediate Win!" Exit Sub Else board$(i, j) = "_" End If End If Next j, i For i = 0 To 2: For j = 0 To 2 ' look for a Spoiler If board$(i, j) = "_" Then board$(i, j) = P$((spaces + 1) Mod 2) If isWin%(board$()) Then ' have to block Print player$; " Best row:"; i; " Best col:"; j; " value was: "; "Spoiler!" Exit Sub Else board$(i, j) = "_" ' OK now play the minimax game! End If End If Next j, i For i = 0 To 2: For j = 0 To 2 'now play minimax game If board$(i, j) = "_" Then board$(i, j) = player$ ' player took a space moveVal = minimax%(board$(), spaces - 1) board$(i, j) = "_" ' player took move back If moveVal > bestVal Then ' remember this move bestRow = i: bestCol = j: bestVal = moveVal End If End If Next j, i Print player$; " Best row:"; bestRow; " Best col:"; bestCol; " value was:"; bestVal Else Print "Game is already done!" End If End Sub
Function minimax% (board$(), spaces%) Dim As Integer score, best, i, j score = isWin%(board$()) If score = 10 Or score = -10 Then minimax% = score + spaces%: Exit Function If spaces% <= 0 Then minimax% = 0: Exit Function If debug Then Dim w$ For i = 0 To 2: For j = 0 To 2: Print board$(i, j);: Next: Print: Next Print "Spaces left coming to minimax is:"; spaces%; " board score:"; score Input " press enter..."; w$ End If 'copy board because QB64 doesn't do by val need recursive level dependent values Dim copyB$(2, 2) For i = 0 To 2: For j = 0 To 2: copyB$(i, j) = board$(i, j): Next j, i If spaces% Mod 2 = 1 Then best = -1000 For i = 0 To 2: For j = 0 To 2 If copyB$(i, j) = "_" Then copyB$(i, j) = P$(1) best = max%(best, minimax%(copyB$(), spaces% - 1)) copyB$(i, j) = "_" End If Next j, i minimax% = best Else best = 1000 For i = 0 To 2: For j = 0 To 2 If copyB$(i, j) = "_" Then copyB$(i, j) = P$(0) best = min%(best, minimax%(copyB$(), spaces% - 1)) copyB$(i, j) = "_" End If Next j, i minimax% = best End If End Function
Function isWin% (b$()) ' winner? return +/-10 or 0 if not Dim As Integer row, col For row = 0 To 2 If b$(row, 0) = b$(row, 1) And b$(row, 1) = b$(row, 2) Then If b$(row, 0) = P$(1) Then isWin% = 10: Exit Function ElseIf b$(row, 0) = P$(0) Then isWin% = -10: Exit Function End If End If Next For col = 0 To 2 If b$(0, col) = b$(1, col) And b$(1, col) = b$(2, col) Then If b$(0, col) = P$(1) Then isWin% = 10: Exit Function ElseIf b$(0, col) = P$(0) Then isWin% = -10: Exit Function End If End If Next If b$(0, 0) = b$(1, 1) And b$(1, 1) = b$(2, 2) Then If b$(0, 0) = P$(1) Then If b$(0, 0) = P$(1) Then isWin% = 10: Exit Function ElseIf b$(0, 0) = P$(0) Then isWin% = -10: Exit Function End If End If End If If b$(0, 2) = b$(1, 1) And b$(1, 1) = b$(2, 0) Then If b$(0, 2) = P$(1) Then If b$(0, 2) = P$(1) Then isWin% = 10: Exit Function ElseIf b$(0, 2) = P$(0) Then isWin% = -10: Exit Function End If End If End If End Function
Function max% (n1%, n2%) If n1% > n2% Then max% = n1% Else max% = n2% End Function
Function min% (n1%, n2%) If n1% > n2% Then min% = n2% Else min% = n1% End Function
|
|
|
Post by bplus on Feb 14, 2024 20:10:18 GMT
By George I think I've got it! It even says to use center square when top left corner x only!
All my test boards work without that ugly hack I put in FindBestMove to catch immediate and spoiler moves, they all work directly from playing MiniMax game! I think my solution a little more elegant in that minimax is called with only 2 arguments instead of 3 AND it looks at the board and knows from the spaces left whose move it is AND whose BestNextMove we are searching for when assigning value of score in isWin%() Function.
So I had another logic bug in the Evaluate sub that I renamed IsWin%. The original code assumed the best move we were searching for was always player x but I was trying both player x and player o so the return good = positive 10 and bad of score = -10 always got set for x point of view.
So here is final fixed code unless someone shows me a board this code does not find the best next move for player x or player o.
Option _Explicit _Title "TTT minimax 4" ' b+ 2024-02-14 ' first decide whose move we are trying to get best move for
' modify isWin%
Dim Shared P$(1), whoseBestMove$, opponent$, debug As Integer P$(0) = "o": P$(1) = "x": debug = 0 ' x plays on moves 1, 3, 5, 7, 9 ' 0 plays on moves 2, 4, 6, 8 ' the number of spaces left mod 2 says x or o eg 9 spaces = x move
' in this main part we just setup a board and and call FindBestMove that answers Dim board$(2, 2), i As Integer, j As Integer
' original board from translation bestMove 2,2 for immediate win board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "x" board$(1, 0) = "o": board$(1, 1) = "o": board$(1, 2) = "x" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' OK got the immediate!
' x move must block o win at 2, 1 because no immediate win board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "x" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' OK got the block!
' o must block x win at 2, 1 by playing it board$(0, 0) = "o": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "_": board$(1, 1) = "x": board$(1, 2) = "_" board$(2, 0) = "x": board$(2, 1) = "_": board$(2, 2) = "_" ' OK got that block so far great!
' immediate win for x at 1, 0 board$(0, 0) = "x": board$(0, 1) = "_": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "x": board$(2, 1) = "_": board$(2, 2) = "o" ' OK got it
' best is 2, 0 then x has win 2 ways that o can only block 1 board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "x": board$(2, 2) = "_" ' oh yes!
' test some more boards best move to start? board$(0, 0) = "_": board$(0, 1) = "_": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "_": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' 1, 1 middle is my guess! ' 0, 0 ??? still you can win from corner ' but a tie might be achieved from any position or any corner?
' after first corner move? should be 1, 1 best chance to win board$(0, 0) = "x": board$(0, 1) = "_": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "_": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' 1, 1 !!! we got it!
'show the board we are talking about For i = 0 To 2: For j = 0 To 2: Print board$(i, j);: Next: Print: Next findBestMove board$() ' this sub print best move and we are done
Sub findBestMove (board$()) Dim As Integer i, j, spaces, bestVal, bestRow, bestCol, moveVal
' whoseBestMove are we trying to optimize x or o ' if amount of spaces mod 2 = 1 then x as x moves first with 9 spaces ' and then every odd number of spaces ' else it is o every even number of spaces
For i = 0 To 2: For j = 0 To 2 ' count spaces left on board If board$(i, j) = "_" Then spaces = spaces + 1 Next j, i
' if the board does not already have a winner and if there are spaces left we continue ' else we are done If isWin%(board$()) = 0 And spaces > 0 Then ' not done!
' set whoseBestMove we are trying to come up with here ' we use this in isWin% to assign a good value 10 ' or bad value -10 if the opponent to whoseBestMove ' this is shared so isWin% knows if they won or lost whoseBestMove$ = P$(spaces Mod 2): bestVal = -1000: bestRow = -1: bestCol = -1 ' also need opponent$ set and shared with isWin% opponent$ = P$((spaces + 1) Mod 2) For i = 0 To 2: For j = 0 To 2 'now play minimax game If board$(i, j) = "_" Then board$(i, j) = whoseBestMove$ ' player took a space moveVal = minimax%(board$(), spaces - 1) ' go deep into recursive dive If moveVal > bestVal Then ' remember this move bestRow = i: bestCol = j: bestVal = moveVal End If board$(i, j) = "_" ' put back the space player took move back End If Next j, i Print whoseBestMove$; " Best row:"; bestRow; " Best col:"; bestCol; " value was:"; bestVal Else ' we are done Print "Game is already done!" End If End Sub
Function minimax% (board$(), spaces%) Dim As Integer score, best, i, j Dim turn$ score = isWin%(board$())
' are we done yet? signals 1) end of line with win or loss 2) no more places to move 'the best win is the earliest that is detected by the most spaces If score = 10 Or score = -10 Then minimax% = score + spaces%: Exit Function If spaces% <= 0 Then minimax% = 0: Exit Function If debug Then Dim w$ For i = 0 To 2: For j = 0 To 2: Print board$(i, j);: Next: Print: Next Print "Spaces left coming to minimax is:"; spaces%; " board score:"; score Input " press enter..."; w$ End If
'copy board because QB64 doesn't do by val need recursive level dependent values Dim copyB$(2, 2) For i = 0 To 2: For j = 0 To 2: copyB$(i, j) = board$(i, j): Next j, i If spaces% Mod 2 = 1 Then turn$ = P$(1) Else turn$ = P$(0) ' x or o turn
If turn$ = whoseBestMove$ Then best = -1000 For i = 0 To 2: For j = 0 To 2 If copyB$(i, j) = "_" Then copyB$(i, j) = turn$ best = max%(best, minimax%(copyB$(), spaces% - 1)) copyB$(i, j) = "_" End If Next j, i minimax% = best Else best = 1000 For i = 0 To 2: For j = 0 To 2 If copyB$(i, j) = "_" Then copyB$(i, j) = turn$ best = min%(best, minimax%(copyB$(), spaces% - 1)) copyB$(i, j) = "_" End If Next j, i minimax% = best End If End Function
Function isWin% (b$()) ' winner? return +/-10 or 0 if not Dim As Integer row, col For row = 0 To 2 If b$(row, 0) = b$(row, 1) And b$(row, 1) = b$(row, 2) Then If b$(row, 0) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(row, 0) = opponent$ Then isWin% = -10: Exit Function End If End If Next For col = 0 To 2 If b$(0, col) = b$(1, col) And b$(1, col) = b$(2, col) Then If b$(0, col) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(0, col) = opponent$ Then isWin% = -10: Exit Function End If End If Next If b$(0, 0) = b$(1, 1) And b$(1, 1) = b$(2, 2) Then If b$(0, 0) = P$(1) Then If b$(0, 0) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(0, 0) = opponent$ Then isWin% = -10: Exit Function End If End If End If If b$(0, 2) = b$(1, 1) And b$(1, 1) = b$(2, 0) Then If b$(0, 2) = P$(1) Then If b$(0, 2) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(0, 2) = opponent$ Then isWin% = -10: Exit Function End If End If End If End Function
Function max% (n1%, n2%) If n1% > n2% Then max% = n1% Else max% = n2% End Function
Function min% (n1%, n2%) If n1% > n2% Then min% = n2% Else min% = n1% End Function code here
|
|
|
Post by anthonyrbrown on Feb 14, 2024 21:29:09 GMT
Looks good bplus well done it's a bit late for me to test it now,so how about testing it below against TIC TAC TOE by Paul Meyer & TheBOB,which my program destroyed! It will be interesting if your code finds the same winning line my program found? or maybe another one? petesqbsite.com/phpBB3/viewtopic.php?t=14868 DECLARE FUNCTION XWIN% (B1 AS INTEGER, B2 AS INTEGER, B3 AS INTEGER, L AS INTEGER) DECLARE FUNCTION OWIN% (B1 AS INTEGER, B2 AS INTEGER, B3 AS INTEGER, L AS INTEGER) DECLARE SUB WINNER (LINEUP AS INTEGER) DECLARE SUB SHOWWIN (B1 AS INTEGER, B2 AS INTEGER, B3 AS INTEGER) DECLARE SUB GETUSERSIGNAL () DECLARE SUB ENABLEMOUSE (C%) DECLARE SUB DRAWSCREEN () DECLARE SUB XO (ROW%, COL%, SYMBOL%)
Dim Shared FALSE As Integer, TRUE As Integer: TRUE = Not FALSE Dim Shared SYMBOLBOX(6000) As Integer '<---NOTE
Dim Shared CH As Integer: 'CURSOR POSITION HORIZONTAL Dim Shared CV As Integer: 'CURSOR POSITION VERTICAL Dim Shared CLICK As Integer: ' 0=NO CLICK, 1=LEFT CLICK, 2=RIGHT ' ENABLEMOUSE 1 = TURN CURSOR ON, RETURN COORDINATES ' ENABLEMOUSE 0 = TURN CURSOR OFF IN ORDER TO DRAW STUFF, ETC. Dim Shared CC As String: 'USER PRESSED KEY ' GETUSERSIGNAL WILL SET RETURN CC OR WILL RETURN CLICK
Dim I As Integer, J As Integer, K As Integer Dim WHOWON As Integer Dim MADEAMOVE As Integer, MOVESMADE As Integer
' ---------------------------------------------------------- ' TITLE SCREEN (MAIN PROGRAM) ' ----------------------------------------------------------- Screen 12 Randomize Timer Dim COMMAND As Integer, HARD As Integer GoSub INITIALIZESCREEN Do Do: GETUSERSIGNAL: Loop Until CLICK = 1 GoSub FINDCLICKEDCOMMAND Select Case COMMAND Case 1: HARD = FALSE WHOWON = 0 GoSub PLAYGAME GoSub SHOWWHOWON GoSub INITIALIZESCREEN Case 2: HARD = TRUE WHOWON = 0 GoSub PLAYGAME GoSub SHOWWHOWON GoSub INITIALIZESCREEN Case 3: GoSub DOHELP GoSub INITIALIZESCREEN Case 4: Exit Do End Select Loop Color 7: Cls System
' ---------------------------------------------------------- ' GAME SCREEN ' ----------------------------------------------------------- Dim Shared ZX(9) As Integer: ' WHERE ALL X'S ARE PLACED Dim Shared ZO(9) As Integer: ' WHERE ALL O'S ARE PLACED Dim Shared ZE(9) As Integer: ' WHERE EMPTY SQUARES ARE Dim THEROW As Integer, THECOLUMN As Integer, THEBOX As Integer
FINDCLICKEDPOSITION: Const DELTA = 4 THEROW = 0: THECOLUMN = 0: THEBOX = 0 Select Case CH Case Is < 170 + DELTA: Return Case Is < 269 - DELTA: THECOLUMN = 1 Case Is < 269 + DELTA: Return Case Is < 368 - DELTA: THECOLUMN = 2 Case Is < 368 + DELTA: Return Case Is < 467 - DELTA: THECOLUMN = 3 Case Else: Return End Select Select Case CV Case Is < 91 + DELTA: Return Case Is < 190 - DELTA: THEROW = 1 Case Is < 190 + DELTA: Return Case Is < 289 - DELTA: THEROW = 2 Case Is < 289 + DELTA: Return Case Is < 388 - DELTA: THEROW = 3 Case Else: Return End Select THEBOX = (3 * (THEROW - 1)) + THECOLUMN Return
' ---------------------------------------------------------- ' PLAY GAME ' ----------------------------------------------------------- PLAYGAME: DRAWSCREEN 'DRAW THE SCREEN AND CREATE X AND O SYMBOLS. For I = 1 To 9: ZO(I) = FALSE: ZX(I) = FALSE: ZE(I) = TRUE: Next I MOVESMADE = 0 Do GETUSERSIGNAL If CLICK Then MADEAMOVE = FALSE GoSub MAKEX If MADEAMOVE Then WHOWON = 1: GoSub COMPUTEWIN: If WHOWON = 1 Then Return T% = 0 For I = 1 To 9: T% = T% + ZX(I): Next I If T% = -5 Then WHOWON = 0: Return MOVESMADE = MOVESMADE + 1 GoSub MAKEO WHOWON = 2: GoSub COMPUTEWIN: If WHOWON = 2 Then Return End If End If If CC = "D" Or CC = Chr$(27) Then WHOWON = 3 If WHOWON > 0 Then Return Loop
MAKEX: GoSub FINDCLICKEDPOSITION If THEBOX = 0 Then Return If Not ZE(THEBOX) Then Return XO THEROW, THECOLUMN, 1: ' PLACES AN X ZX(THEBOX) = TRUE: ZE(THEBOX) = FALSE MADEAMOVE = TRUE Return
MAKEO: GoSub FINDPLACEFORO Sleep 1: While InKey$ <> "": Wend XO THEROW, THECOLUMN, 0: 'PLACES AN O ZO(THEBOX) = TRUE: ZE(THEBOX) = FALSE Return
COMPUTEWIN: If WHOWON = 1 Then If XWIN(1, 2, 3, 1) Then Return If XWIN(4, 5, 6, 2) Then Return If XWIN(7, 8, 9, 3) Then Return If XWIN(1, 4, 7, 4) Then Return If XWIN(2, 5, 8, 5) Then Return If XWIN(3, 6, 9, 6) Then Return If XWIN(1, 5, 9, 7) Then Return If XWIN(3, 5, 7, 8) Then Return Else If OWIN(1, 2, 3, 1) Then Return If OWIN(4, 5, 6, 2) Then Return If OWIN(7, 8, 9, 3) Then Return If OWIN(1, 4, 7, 4) Then Return If OWIN(2, 5, 8, 5) Then Return If OWIN(3, 6, 9, 6) Then Return If OWIN(1, 5, 9, 7) Then Return If OWIN(3, 5, 7, 8) Then Return End If WHOWON = 0 Return
FINDPLACEFORO: ' SEE IF THERE IS A WIN FOR O. IF SO, TAKE IT. ' SEE IF THERE IS A THREAT OF A WIN FOR X. IF SO, BLOCK IT. For TESTTYPE% = 1 To 2 THEBOX = 0 For THEROW = 1 To 3: For THECOLUMN = 1 To 3 THEBOX = THEBOX + 1 If ZE(THEBOX) Then TK$ = "" Select Case THEBOX Case 1: TK$ = "234759" Case 2: TK$ = "1358" Case 3: TK$ = "126957" Case 4: TK$ = "1756" Case 5: TK$ = "19283746" Case 6: TK$ = "4539" Case 7: TK$ = "148935" Case 8: TK$ = "2579" Case 9: TK$ = "153678" End Select For I = 1 To Len(TK$) Step 2 J = Val(Mid$(TK$, I, 1)) K = Val(Mid$(TK$, I + 1, 1)) If TESTTYPE% = 1 Then If ZO(J) + ZO(K) < -1 Then Return Else If ZX(J) + ZX(K) < -1 Then Return End If Next I End If Next THECOLUMN: Next THEROW Next TESTTYPE% ' NO MOVE SELECTED ABOVE TO WIN OR BLOCK WIN, SO If HARD Then If MOVESMADE = 1 Then If ZE(5) Then THEROW = 2: THECOLUMN = 2: THEBOX = 5 Else If Rnd > .5 Then THEROW = 1 Else THEROW = 3 If Rnd > .5 Then THECOLUMN = 1 Else THECOLUMN = 3 THEBOX = (3 * (THEROW - 1)) + THECOLUMN End If Return ElseIf MOVESMADE = 2 Then If ZX(5) Then TK$ = "" If ZO(1) And ZX(9) Then TK$ = "37" ElseIf ZO(3) And ZX(7) Then TK$ = "19" ElseIf ZO(7) And ZX(3) Then TK$ = "19" ElseIf ZO(9) And ZX(1) Then TK$ = "37" End If If TK$ <> "" Then If Rnd > .5 Then THEBOX = Val(Left$(TK$, 1)) Else THEBOX = Val(Left$(TK$, 1)) End If THEROW = (THEBOX + 2) \ 3 THECOLUMN = THEBOX - (3 * (THEROW - 1)) Return End If Else Do Do: THEBOX = 2 * Int(1 + (Rnd * 4)): Loop While Not ZE(THEBOX) Select Case THEBOX Case 2: If Not ZX(8) Then Exit Do Case 4: If Not ZX(6) Then Exit Do Case 6: If Not ZX(4) Then Exit Do Case 8: If Not ZX(2) Then Exit Do End Select Loop THEROW = (THEBOX + 2) \ 3 THECOLUMN = THEBOX - (3 * (THEROW - 1)) Return End If End If End If ' OK, NO GOOD MOVE WAS FOUND. MAKE A RANDOM ONE Do: THEBOX = 1 + Int(Rnd * 9): Loop While Not ZE(THEBOX) THEROW = (THEBOX + 2) \ 3 THECOLUMN = THEBOX - (3 * (THEROW - 1)) Return
SHUFFLE: Do While Len(W1$) < 4 R% = 1 + Int(Rnd * 4) If Mid$(W2$, R%, 1) <> "X" Then W1$ = W1$ + Mid$(W2$, R%, 1) Mid$(W2$, R%, 1) = "X" End If Loop Return
SHOWWHOWON: Select Case WHOWON Case 0: C$ = "TIE! " Case 1: C$ = "YOU WIN! " Case 2: C$ = "YOU LOSE! " Case 3: C$ = "YOU RESIGNED?" End Select If WHOWON < 3 Then Sleep 2: While InKey$ <> "": Wend Cls For I = 1 To 30 Color 1 + Int(Rnd * 15) Locate I, I + 20 Print C$; Next I Sleep 3: While InKey$ <> "": Wend Return
INITIALIZESCREEN: Cls Color 15 Locate 4, 23: Print "TIC TAC TOE BY PAUL MEYER & THEBOB" Locate 6, 27: Print "(C) 2004 - 2007 DOS-ID GAMES" Color 3 DS% = 131: DD% = 97: DZ% = 75 Line (DS%, 343)-(DS% + DZ%, 380), , BF Line (DS% + (1 * DD%), 343)-(DS% + (1 * DD%) + DZ%, 380), , BF Line (DS% + (2 * DD%), 343)-(DS% + (2 * DD%) + DZ%, 380), , BF Line (DS% + (3 * DD%), 343)-(DS% + (3 * DD%) + DZ%, 380), , BF Locate 23, 19: Print " EASY "; Locate , 31: Print " HARD "; Locate , 43: Print " INFO "; Locate , 55: Print " QUIT " Return
FINDCLICKEDCOMMAND: COMMAND = 0 Select Case CV Case Is < 343: Return Case Is > 380: Return End Select Select Case CH Case Is < 130: Return Case Is < 205: COMMAND = 1 Case Is < 227: Return Case Is < 303: COMMAND = 2 Case Is < 325: Return Case Is < 400: COMMAND = 3 Case Is < 421: Return Case Is < 497: COMMAND = 4 End Select Return
DOHELP: Cls Color 2 Locate 3, 1 Print "CREDITS" Print "-------" Print "THIS GAME WAS CREATED BY PAUL MEYER IN THE YEAR 2007." Print: Print "GRAPHICS BY THEBOB" Print: Print "IMPROVED MOUSE DRIVER, MODULARITY, MACHINE PLAY-TO-WIN"; Print " BY QBASIC MAC" Print: Print "HISTORY:" Print "HTTP://WWW.NETWORK54.COM/FORUM/190883/MESSAGE/1175106480" Print Print "THIS IS FREEWARE, YOU MAY CHANGE THIS AS MUCH AS YOU WANT" Print "AS LONG AS YOU DON'T CLAIM IT AS YOURS." Print Print Print "ABOUT" Print "-----" Print "THIS IS JUST A SIMPLE TIC TAC TOE GAME WITH MOUSE DRIVERS." Print "THIS GAME WAS CREATED IN QUICKBASIC." Call GETUSERSIGNAL Cls Return
Sub DRAWSCREEN Dim X As Integer, Y As Integer Static FINISHED As Integer Cls Out &H3C8, 0: Out &H3C9, 0: Out &H3C9, 0: Out &H3C9, 18 Out &H3C8, 4: Out &H3C9, 63: Out &H3C9, 0: Out &H3C9, 0 Out &H3C8, 9: Out &H3C9, 0: Out &H3C9, 12: Out &H3C9, 48 Out &H3C8, 11: Out &H3C9, 0: Out &H3C9, 18: Out &H3C9, 54 Color 7: Locate 3, 31: Print "T I C - T A C - T O E" Line (170, 90)-(490, 410), 0, BF Line (160, 81)-(479, 399), 1, BF Line (155, 76)-(483, 404), 8, B Line (152, 73)-(487, 407), 8, B Line (160, 81)-(160, 399), 9 Line (160, 81)-(479, 81), 9 Line (371, 92)-(372, 393), 0, B Line (271, 92)-(272, 392), 0, B Line (171, 191)-(472, 192), 0, B Line (171, 291)-(472, 292), 0, B Line (369, 90)-(370, 390), 13, B Line (269, 90)-(270, 390), 13, B Line (169, 189)-(470, 190), 13, B Line (169, 289)-(470, 290), 13, B Line (5, 5)-(634, 474), 8, B Line (10, 10)-(629, 469), 8, B If FINISHED Then Exit Sub FINISHED = TRUE For X = 194 To 500 For Y = 32 To 46 If Point(X, Y) = 8 Then PSet (X, Y), 7 Next Y Next X PSet (188, 108), 0 Draw "E3 F30 E30 F6 G30 F30 G6 H30 G30 H6 E30 H30 E3 BF2 P0,0" PSet (186, 106), 10 Draw "E3 F30 E30 F6 G30 F30 G6 H30 G30 H6 E30 H30 E3 BF2 P10,10" Circle (322, 141), 31, 0 Circle (322, 141), 37, 0 Paint Step(0, 35), 0 PSet Step(0, -35), 0 Circle (320, 139), 31, 4 Circle (320, 139), 37, 4 Paint Step(0, 35), 4 PSet Step(0, -35), 1 Get Step(-40, -40)-Step(81, 81), SYMBOLBOX() Get (179, 98)-(260, 178), SYMBOLBOX(3000) XO 1, 1, 2: XO 1, 2, 2 End Sub
Sub ENABLEMOUSE (C%) Static STATUS As Integer If STATUS = 0 And C% = 0 Then Exit Sub Static MX As String If MX = "" Then M$ = "58E85080585080585080850815510C358508058508085080850815C00" N$ = "595BECB70BEAB70BE8BFBE6B7B8E7D33BEC978BEA97BE89FBE697DA80" MX = Space$(57) For I% = 1 To 57 H$ = Chr$(Val("&H" + Mid$(M$, I%, 1) + Mid$(N$, I%, 1))) Mid$(MX, I%, 1) = H$ Next I% End If If C% = 0 Then Call Absolute(2, CLICK, CH, CV, SAdd(MX)) STATUS = 0 Exit Sub End If If STATUS = 0 Then Call Absolute(1, CLICK, CH, CV, SAdd(MX)) STATUS = 1 Call Absolute(3, CLICK, CH, CV, SAdd(MX)) End Sub
Sub GETUSERSIGNAL Do If 0 Then ' SET TO 1 FOR DEBUGGING PRINTOUT, OTHERWISE 0 Locate 2, 1 Print CLICK; "<CLICK" Print CH; "CH (HORIZONTAL)" Print CV; "CV (VERTICLE)" End If ENABLEMOUSE 1 If CLICK > 0 Then K% = CLICK While CLICK <> 0: ENABLEMOUSE 1: Wend CLICK = K% Exit Do End If CC = InKey$ Loop While CC = "" ENABLEMOUSE 0 End Sub
Function OWIN% (B1 As Integer, B2 As Integer, B3 As Integer, L As Integer) If ZO(B1) = 0 Or ZO(B2) = 0 Or ZO(B3) = 0 Then Exit Function WINNER L OWIN% = -1 End Function
Sub WINNER (LINEUP As Integer) Select Case LINEUP Case 1: Line (200, 140)-(440, 142), 14, BF: Line (200, 143)-(440, 144), 0, B Case 2: Line (200, 240)-(440, 242), 14, BF: Line (200, 243)-(440, 244), 0, B Case 3: Line (200, 340)-(440, 342), 14, BF: Line (200, 343)-(440, 344), 0, B Case 4: Line (220, 120)-(222, 360), 14, BF: Line (223, 120)-(223, 360), 0 Case 5: Line (320, 120)-(322, 360), 14, BF: Line (323, 120)-(323, 360), 0 Case 6: Line (420, 120)-(422, 360), 14, BF: Line (423, 120)-(423, 360), 0 Case 7: PSet (200, 120), 14: Draw "F240 D H240 D F240 D H240 D C0 F240 D H240" Case 8: PSet (440, 120), 14: Draw "G240 D E240 D G240 D E240 D C0 G240 D E240" End Select End Sub
Sub XO (ROW As Integer, COL As Integer, SYMBOL As Integer) Dim INDEX As Integer, X As Integer, Y As Integer X = (COL - 1) * 100 + 180 Y = (ROW - 1) * 100 + 100 INDEX = SYMBOL * 3000 If INDEX < 6000 Then Put (X, Y), SYMBOLBOX(INDEX), PSet Else Line (X, Y)-(X + 80, Y + 80), 1, BF End If End Sub
Function XWIN% (B1 As Integer, B2 As Integer, B3 As Integer, L As Integer) If ZX(B1) = 0 Or ZX(B2) = 0 Or ZX(B3) = 0 Then Exit Function WINNER L XWIN% = -1 End Function
|
|
|
Post by bplus on Feb 15, 2024 0:15:58 GMT
Some TTT's just pick a random empty cell, that weak humans prefer to play.
I found my old TTT with AI that would fail if x plays a corner, o the center then x plays opposite corner. My AI at time before I fixed always favored corners but that is death!
Here is that board and my current Minimax makes the right move = any side, no corner!
Here is how game played out one best move after the other:
' here is board that failed on my first AI version ' play any side just dont play corner!!! board$(0, 0) = "x": board$(0, 1) = "_": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "x" ' plays 0, 1 a side, good
'lets continue game board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "x" ' spoiler of course 2, 1
' now it doesn't matter o can attempt immdeiate win but should be stopped board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "x": board$(2, 2) = "x" ' plays o 2, 0
board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "o": board$(2, 1) = "x": board$(2, 2) = "x" 'x blocks 0, 2 board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "x" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "o": board$(2, 1) = "x": board$(2, 2) = "x" ' o blocks 1, 2 board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "x" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "o" board$(2, 0) = "o": board$(2, 1) = "x": board$(2, 2) = "x" 'only one move left 1, 0 yep!
|
|
|
Post by bplus on Feb 15, 2024 1:05:12 GMT
Oh Rats! Another freak'n error in the evaluate=isWin%() function. It had a bad fix for detecting diagonals that I failed to notice when I was overhauling that routine.
So I caught it running a game from the beginning x best move at 0,0 for blank board.
' after first corner move? should be 1, 1 best chance to win board$(0, 0) = "x": board$(0, 1) = "_": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "_": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' 1, 1 !!! we got it! board$(0, 0) = "x": board$(0, 1) = "_": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' x 0, 1 board$(0, 0) = "x": board$(0, 1) = "x": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' o 0,2 to block board$(0, 0) = "x": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' x 1, 0 dang crap! mistake! board$(0, 0) = "x": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "x": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' o 2, 0 of course and wins board$(0, 0) = "x": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "x": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "o": board$(2, 1) = "_": board$(2, 2) = "_" ' x 1,2 no acknowldge win???
I check diagonal detecting code and yes sir! it was screwed up!
OK let's see how it runs fixed up:
Option _Explicit _Title "TTT minimax 4_oops!" ' b+ 2024-02-14 fix diagonal detecting in isWin% ' first decide whose move we are trying to get best move for
' modify isWin%
Dim Shared P$(1), whoseBestMove$, opponent$, debug As Integer P$(0) = "o": P$(1) = "x": debug = 0 ' x plays on moves 1, 3, 5, 7, 9 ' 0 plays on moves 2, 4, 6, 8 ' the number of spaces left mod 2 says x or o eg 9 spaces = x move
' in this main part we just setup a board and and call FindBestMove that answers Dim board$(2, 2), i As Integer, j As Integer
' original board from translation bestMove 2,2 for immediate win board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "x" board$(1, 0) = "o": board$(1, 1) = "o": board$(1, 2) = "x" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' OK got the immediate!
' x move must block o win at 2, 1 because no immediate win board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "x" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' OK got the block!
' o must block x win at 2, 1 by playing it board$(0, 0) = "o": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "_": board$(1, 1) = "x": board$(1, 2) = "_" board$(2, 0) = "x": board$(2, 1) = "_": board$(2, 2) = "_" ' OK got that block so far great!
' immediate win for x at 1, 0 board$(0, 0) = "x": board$(0, 1) = "_": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "x": board$(2, 1) = "_": board$(2, 2) = "o" ' OK got it
' best is 2, 0 then x has win 2 ways that o can only block 1 board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "x": board$(2, 2) = "_" ' oh yes!
' test some more boards best move to start? board$(0, 0) = "_": board$(0, 1) = "_": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "_": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' 1, 1 middle is my guess! ' 0, 0 ??? still you can win from corner ' but a tie might be achieved from any position or any corner? board$(0, 0) = "x": board$(0, 1) = "_": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "_": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' o 1, 1 board$(0, 0) = "x": board$(0, 1) = "_": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' ah now x 0, 1 oh that's interesting forcing o 0,2 forcing x 2,0 forcing o 1,0 board$(0, 0) = "x": board$(0, 1) = "x": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' o 0, 2 see! board$(0, 0) = "x": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' x 2, 0 board$(0, 0) = "x": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "_": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "x": board$(2, 1) = "_": board$(2, 2) = "_" ' o 1, 0 forcing x 1, 2 board$(0, 0) = "x": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "o": board$(1, 1) = "o": board$(1, 2) = "_" board$(2, 0) = "x": board$(2, 1) = "_": board$(2, 2) = "_" ' x 1, 2 yep board$(0, 0) = "x": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "o": board$(1, 1) = "o": board$(1, 2) = "x" board$(2, 0) = "x": board$(2, 1) = "_": board$(2, 2) = "_" ' and nutt'n left to win ' but AI don't know so o 2, 1 board$(0, 0) = "x": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "o": board$(1, 1) = "o": board$(1, 2) = "x" board$(2, 0) = "x": board$(2, 1) = "o": board$(2, 2) = "_" ' x 2, 2 and done board$(0, 0) = "x": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "o": board$(1, 1) = "o": board$(1, 2) = "x" board$(2, 0) = "x": board$(2, 1) = "o": board$(2, 2) = "x" ' Game is already done! see
'show the board we are talking about For i = 0 To 2: For j = 0 To 2: Print board$(i, j);: Next: Print: Next findBestMove board$() ' this sub print best move and we are done
Sub findBestMove (board$()) Dim As Integer i, j, spaces, bestVal, bestRow, bestCol, moveVal
' whoseBestMove are we trying to optimize x or o ' if amount of spaces mod 2 = 1 then x as x moves first with 9 spaces ' and then every odd number of spaces ' else it is o every even number of spaces
For i = 0 To 2: For j = 0 To 2 ' count spaces left on board If board$(i, j) = "_" Then spaces = spaces + 1 Next j, i
' if the board does not already have a winner and if there are spaces left we continue ' else we are done If isWin%(board$()) = 0 And spaces > 0 Then ' not done!
' set whoseBestMove we are trying to come up with here ' we use this in isWin% to assign a good value 10 ' or bad value -10 if the opponent to whoseBestMove ' this is shared so isWin% knows if they won or lost whoseBestMove$ = P$(spaces Mod 2): bestVal = -1000: bestRow = -1: bestCol = -1 ' also need opponent$ set and shared with isWin% opponent$ = P$((spaces + 1) Mod 2) For i = 0 To 2: For j = 0 To 2 'now play minimax game If board$(i, j) = "_" Then board$(i, j) = whoseBestMove$ ' player took a space moveVal = minimax%(board$(), spaces - 1) ' go deep into recursive dive If moveVal > bestVal Then ' remember this move bestRow = i: bestCol = j: bestVal = moveVal End If board$(i, j) = "_" ' put back the space player took move back End If Next j, i Print whoseBestMove$; " Best row:"; bestRow; " Best col:"; bestCol; " value was:"; bestVal Else ' we are done Print "Game is already done!" End If End Sub
Function minimax% (board$(), spaces%) Dim As Integer score, best, i, j Dim turn$ score = isWin%(board$())
' are we done yet? signals 1) end of line with win or loss 2) no more places to move 'the best win is the earliest that is detected by the most spaces If score = 10 Or score = -10 Then minimax% = score + spaces%: Exit Function If spaces% <= 0 Then minimax% = 0: Exit Function If debug Then Dim w$ For i = 0 To 2: For j = 0 To 2: Print board$(i, j);: Next: Print: Next Print "Spaces left coming to minimax is:"; spaces%; " board score:"; score Input " press enter..."; w$ End If
'copy board because QB64 doesn't do by val need recursive level dependent values Dim copyB$(2, 2) For i = 0 To 2: For j = 0 To 2: copyB$(i, j) = board$(i, j): Next j, i If spaces% Mod 2 = 1 Then turn$ = P$(1) Else turn$ = P$(0) ' x or o turn
If turn$ = whoseBestMove$ Then best = -1000 For i = 0 To 2: For j = 0 To 2 If copyB$(i, j) = "_" Then copyB$(i, j) = turn$ best = max%(best, minimax%(copyB$(), spaces% - 1)) copyB$(i, j) = "_" End If Next j, i minimax% = best Else best = 1000 For i = 0 To 2: For j = 0 To 2 If copyB$(i, j) = "_" Then copyB$(i, j) = turn$ best = min%(best, minimax%(copyB$(), spaces% - 1)) copyB$(i, j) = "_" End If Next j, i minimax% = best End If End Function
Function isWin% (b$()) ' winner? return +/-10 or 0 if not Dim As Integer row, col For row = 0 To 2 If b$(row, 0) = b$(row, 1) And b$(row, 1) = b$(row, 2) Then If b$(row, 0) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(row, 0) = opponent$ Then isWin% = -10: Exit Function End If End If Next For col = 0 To 2 If b$(0, col) = b$(1, col) And b$(1, col) = b$(2, col) Then If b$(0, col) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(0, col) = opponent$ Then isWin% = -10: Exit Function End If End If Next If b$(0, 0) = b$(1, 1) And b$(1, 1) = b$(2, 2) Then If b$(0, 0) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(0, 0) = opponent$ Then isWin% = -10: Exit Function End If End If If b$(0, 2) = b$(1, 1) And b$(1, 1) = b$(2, 0) Then If b$(0, 2) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(0, 2) = opponent$ Then isWin% = -10: Exit Function End If End If End Function
Function max% (n1%, n2%) If n1% > n2% Then max% = n1% Else max% = n2% End Function
Function min% (n1%, n2%) If n1% > n2% Then min% = n2% Else min% = n1% End Function
As expected it runs perfect game to a tie.
|
|
|
Post by bplus on Feb 15, 2024 1:22:40 GMT
Here is the TTT minimax 5.bas cleaned up a bit, best version yet for minimax TTT for QB64.
Option _Explicit _Title "TTT minimax 5" ' b+ 2024-02-14 fix diagonal detecting in isWin% ' this is 3rd fix for evaluate = isWin% function ' minimax must be pretty close to perfected I would guess.
Dim Shared P$(1), whoseBestMove$, opponent$, debug As Integer P$(0) = "o": P$(1) = "x": debug = 0 ' x plays on moves 1, 3, 5, 7, 9 ' o plays on moves 2, 4, 6, 8 ' the number of spaces left mod 2 says x or o eg 9 spaces = x move
' in this main part we just setup a board and and call FindBestMove Dim board$(2, 2), i As Integer, j As Integer
' original board from translation bestMove 2,2 for immediate win board$(0, 0) = "x": board$(0, 1) = "o": board$(0, 2) = "x" board$(1, 0) = "o": board$(1, 1) = "o": board$(1, 2) = "x" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "_" ' OK got the immediate!
'show the board we are talking about For i = 0 To 2: For j = 0 To 2: Print board$(i, j);: Next: Print: Next findBestMove board$() ' this sub print best move and we are done
Sub findBestMove (board$()) Dim As Integer i, j, spaces, bestVal, bestRow, bestCol, moveVal
' whoseBestMove are we trying to optimize x or o ' if amount of spaces mod 2 = 1 then x as x moves first with 9 spaces ' and then every odd number of spaces ' else it is o every even number of spaces
For i = 0 To 2: For j = 0 To 2 ' count spaces left on board If board$(i, j) = "_" Then spaces = spaces + 1 Next j, i
' if the board does not already have a winner and if there are spaces left we continue ' else we are done If isWin%(board$()) = 0 And spaces > 0 Then ' not done!
' set whoseBestMove we are trying to come up with here ' we use this in isWin% to assign a good value 10 ' or bad value -10 if the opponent to whoseBestMove ' this is shared so isWin% knows if they won or lost whoseBestMove$ = P$(spaces Mod 2): bestVal = -1000: bestRow = -1: bestCol = -1 ' also need opponent$ set and shared with isWin% opponent$ = P$((spaces + 1) Mod 2) For i = 0 To 2: For j = 0 To 2 'now play minimax game If board$(i, j) = "_" Then board$(i, j) = whoseBestMove$ ' player took a space moveVal = minimax%(board$(), spaces - 1) ' go deep into recursive dive If moveVal > bestVal Then ' remember this move bestRow = i: bestCol = j: bestVal = moveVal End If board$(i, j) = "_" ' put back the space player took End If Next j, i Print whoseBestMove$; " Best row:"; bestRow; " Best col:"; bestCol; " value was:"; bestVal Else ' we are done Print "Game is already done!" End If End Sub
Function minimax% (board$(), spaces%) Dim As Integer score, best, i, j Dim turn$ score = isWin%(board$())
' are we done yet? signals ' 1) end of line with win 10 or loss-10 ' 2) no more places to move 'the best win is the earliest that is detected by the most spaces If score = 10 Or score = -10 Then minimax% = score + spaces%: Exit Function If spaces% <= 0 Then minimax% = 0: Exit Function
If debug Then ' check to see how the recursive callsare going Dim w$ For i = 0 To 2: For j = 0 To 2: Print board$(i, j);: Next: Print: Next Print "Spaces left coming to minimax is:"; spaces%; " board score:"; score Input " press enter..."; w$ End If
'copy board because QB64 doesn't do by val need recursive level dependent values Dim copyB$(2, 2) ' make a copy of this recursive instance of the board For i = 0 To 2: For j = 0 To 2: copyB$(i, j) = board$(i, j): Next j, i 'whose turn is it, decided by number of spaces left If spaces% Mod 2 = 1 Then turn$ = P$(1) Else turn$ = P$(0) ' x or o turn
If turn$ = whoseBestMove$ Then ' is turn the one we are finding best move for? best = -1000 For i = 0 To 2: For j = 0 To 2 If copyB$(i, j) = "_" Then copyB$(i, j) = turn$ best = max%(best, minimax%(copyB$(), spaces% - 1)) copyB$(i, j) = "_" End If Next j, i minimax% = best Else ' or is it whoseBestMoves opponents turn best = 1000 For i = 0 To 2: For j = 0 To 2 If copyB$(i, j) = "_" Then copyB$(i, j) = turn$ best = min%(best, minimax%(copyB$(), spaces% - 1)) copyB$(i, j) = "_" End If Next j, i minimax% = best End If End Function
Function isWin% (b$()) ' winner? return +/-10 or 0 if not Dim As Integer row, col For row = 0 To 2 If b$(row, 0) = b$(row, 1) And b$(row, 1) = b$(row, 2) Then If b$(row, 0) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(row, 0) = opponent$ Then isWin% = -10: Exit Function End If End If Next For col = 0 To 2 If b$(0, col) = b$(1, col) And b$(1, col) = b$(2, col) Then If b$(0, col) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(0, col) = opponent$ Then isWin% = -10: Exit Function End If End If Next If b$(0, 0) = b$(1, 1) And b$(1, 1) = b$(2, 2) Then If b$(0, 0) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(0, 0) = opponent$ Then isWin% = -10: Exit Function End If End If If b$(0, 2) = b$(1, 1) And b$(1, 1) = b$(2, 0) Then If b$(0, 2) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(0, 2) = opponent$ Then isWin% = -10: Exit Function End If End If End Function
Function max% (n1%, n2%) If n1% > n2% Then max% = n1% Else max% = n2% End Function
Function min% (n1%, n2%) If n1% > n2% Then min% = n2% Else min% = n1% End Function
|
|
|
Post by bplus on Feb 15, 2024 1:47:34 GMT
testing version 5 TTT minimax with a board position I was curious about o__ _x_ __x
Here is how it played out in 5.1
Option _Explicit _Title "TTT minimax 5.1" ' b+ 2024-02-14 play out opening board o's move ' this is 3rd fix for evaluate = isWin% function ' minimax must be pretty close to perfected I would guess.
Dim Shared P$(1), whoseBestMove$, opponent$, debug As Integer P$(0) = "o": P$(1) = "x": debug = 0 ' x plays on moves 1, 3, 5, 7, 9 ' o plays on moves 2, 4, 6, 8 ' the number of spaces left mod 2 says x or o eg 9 spaces = x move
' in this main part we just setup a board and and call FindBestMove Dim board$(2, 2), i As Integer, j As Integer
' I am curious how this plays out board$(0, 0) = "o": board$(0, 1) = "_": board$(0, 2) = "_" board$(1, 0) = "_": board$(1, 1) = "x": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "x" ' o 0,2 board$(0, 0) = "o": board$(0, 1) = "_": board$(0, 2) = "o" board$(1, 0) = "_": board$(1, 1) = "x": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "x" ' x 0,1 has to board$(0, 0) = "o": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "_": board$(1, 1) = "x": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "_": board$(2, 2) = "x" ' o 2, 1 has to board$(0, 0) = "o": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "_": board$(1, 1) = "x": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "o": board$(2, 2) = "x" ' so x threatens either 1,0 or 1, 2 or kills all wins at 2, 0 ' i say mini will pick first 1, 0 yep! gots to keep trying to win board$(0, 0) = "o": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "x": board$(1, 1) = "x": board$(1, 2) = "_" board$(2, 0) = "_": board$(2, 1) = "o": board$(2, 2) = "x" ' and o did not fall asleep o 1, 2 that about all folks board$(0, 0) = "o": board$(0, 1) = "x": board$(0, 2) = "o" board$(1, 0) = "x": board$(1, 1) = "x": board$(1, 2) = "o" board$(2, 0) = "_": board$(2, 1) = "o": board$(2, 2) = "x" ' x 2, 0 another tie game
'show the board we are talking about For i = 0 To 2: For j = 0 To 2: Print board$(i, j);: Next: Print: Next findBestMove board$() ' this sub print best move and we are done
Sub findBestMove (board$()) Dim As Integer i, j, spaces, bestVal, bestRow, bestCol, moveVal
' whoseBestMove are we trying to optimize x or o ' if amount of spaces mod 2 = 1 then x as x moves first with 9 spaces ' and then every odd number of spaces ' else it is o every even number of spaces
For i = 0 To 2: For j = 0 To 2 ' count spaces left on board If board$(i, j) = "_" Then spaces = spaces + 1 Next j, i
' if the board does not already have a winner and if there are spaces left we continue ' else we are done If isWin%(board$()) = 0 And spaces > 0 Then ' not done!
' set whoseBestMove we are trying to come up with here ' we use this in isWin% to assign a good value 10 ' or bad value -10 if the opponent to whoseBestMove ' this is shared so isWin% knows if they won or lost whoseBestMove$ = P$(spaces Mod 2): bestVal = -1000: bestRow = -1: bestCol = -1 ' also need opponent$ set and shared with isWin% opponent$ = P$((spaces + 1) Mod 2) For i = 0 To 2: For j = 0 To 2 'now play minimax game If board$(i, j) = "_" Then board$(i, j) = whoseBestMove$ ' player took a space moveVal = minimax%(board$(), spaces - 1) ' go deep into recursive dive If moveVal > bestVal Then ' remember this move bestRow = i: bestCol = j: bestVal = moveVal End If board$(i, j) = "_" ' put back the space player took End If Next j, i Print whoseBestMove$; " Best row:"; bestRow; " Best col:"; bestCol; " value was:"; bestVal Else ' we are done Print "Game is already done!" End If End Sub
Function minimax% (board$(), spaces%) Dim As Integer score, best, i, j Dim turn$ score = isWin%(board$())
' are we done yet? signals ' 1) end of line with win 10 or loss-10 ' 2) no more places to move 'the best win is the earliest that is detected by the most spaces If score = 10 Or score = -10 Then minimax% = score + spaces%: Exit Function If spaces% <= 0 Then minimax% = 0: Exit Function
If debug Then ' check to see how the recursive callsare going Dim w$ For i = 0 To 2: For j = 0 To 2: Print board$(i, j);: Next: Print: Next Print "Spaces left coming to minimax is:"; spaces%; " board score:"; score Input " press enter..."; w$ End If
'copy board because QB64 doesn't do by val need recursive level dependent values Dim copyB$(2, 2) ' make a copy of this recursive instance of the board For i = 0 To 2: For j = 0 To 2: copyB$(i, j) = board$(i, j): Next j, i 'whose turn is it, decided by number of spaces left If spaces% Mod 2 = 1 Then turn$ = P$(1) Else turn$ = P$(0) ' x or o turn
If turn$ = whoseBestMove$ Then ' is turn the one we are finding best move for? best = -1000 For i = 0 To 2: For j = 0 To 2 If copyB$(i, j) = "_" Then copyB$(i, j) = turn$ best = max%(best, minimax%(copyB$(), spaces% - 1)) copyB$(i, j) = "_" End If Next j, i minimax% = best Else ' or is it whoseBestMoves opponents turn best = 1000 For i = 0 To 2: For j = 0 To 2 If copyB$(i, j) = "_" Then copyB$(i, j) = turn$ best = min%(best, minimax%(copyB$(), spaces% - 1)) copyB$(i, j) = "_" End If Next j, i minimax% = best End If End Function
Function isWin% (b$()) ' winner? return +/-10 or 0 if not Dim As Integer row, col For row = 0 To 2 If b$(row, 0) = b$(row, 1) And b$(row, 1) = b$(row, 2) Then If b$(row, 0) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(row, 0) = opponent$ Then isWin% = -10: Exit Function End If End If Next For col = 0 To 2 If b$(0, col) = b$(1, col) And b$(1, col) = b$(2, col) Then If b$(0, col) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(0, col) = opponent$ Then isWin% = -10: Exit Function End If End If Next If b$(0, 0) = b$(1, 1) And b$(1, 1) = b$(2, 2) Then If b$(0, 0) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(0, 0) = opponent$ Then isWin% = -10: Exit Function End If End If If b$(0, 2) = b$(1, 1) And b$(1, 1) = b$(2, 0) Then If b$(0, 2) = whoseBestMove$ Then isWin% = 10: Exit Function ElseIf b$(0, 2) = opponent$ Then isWin% = -10: Exit Function End If End If End Function
Function max% (n1%, n2%) If n1% > n2% Then max% = n1% Else max% = n2% End Function
Function min% (n1%, n2%) If n1% > n2% Then min% = n2% Else min% = n1% End Function
|
|
|
Post by anthonyrbrown on Feb 27, 2024 12:15:47 GMT
|
|