07-30-2024, 06:57 PM
Computer AI The Movie
Watch the drama unfold as the Computer AI Hunts down and sinks your ships!
Code: (Select All)
_Title "BS Mod842 AI Movie 2024-07-30"
' b+ 2024-07-26 port from JB
' Battleship Mod842 b+ 2024-07-25 uses a garanteed AI to find Destroyer in 50 shots
' unlike Battleship 2 which AI uses mod 3 it is screwed if fails to find Destroyer when mod 3
' shooting covers the ocean taking something like up to 66 shots to garantee finding Destroyer.
' This code starts from my first Battleship coded for JB:
' Battleship based on Hasbro Game b+ 2024-07-23 allot of code ported out of old QB64 version
' 2024-07-26 besides port trans back to QB64, fix the showing of computer ships so only the ones
' or parts not hit with ship number. Add Sound when ship is hit.
' 2024-07-29 Oh I forgot, MessageBox does not work for older versions of QB64.
' Actually that turns out to be no problem at all!!!
' I think I can use View Print and not need my Message and Message Clear subroutines.
' This might be a very cool fix! Also I am going to work on my organization and commenting.
' OK View Print did not scroll inside the view text port so I had to cls before turning off
' View Print. I was thinking scrolling would be cool, no cls needed but no.
' Fix a bug that has been here from beginning, check player's bomb site to see if already done
' if so BEEP him, definitely don't want to sink a ship twice which is what has been happening.
' So we should use computer c() to track players shots. -1 for miss but what about when ship
' is hit??? c(x, y) = c(x, y) + 10 so if c(x, y) is > 5 and < 11 then good hit.
' if c(x,y) > 10 then already hit. BEEPing now for places already bombed plus give player another
' chance to shoot.
' Need to check place$ to see if player screwed up placement instructions, done.
' 2024-07-30 BS Mod842 AI Movie - last night I got this great idea and want to share it.
' This Movie shows The Computer AI in action finding and sinking ships, it does so with
' minimum interruption from viewer/Player. I do want to set it so the Player can setup
' tricky ship placements to test how well the AI handles them, also excellent tool to
' improve the AI because just watching a number of these I see AI failures clearly some
' holes left in coverage...
' Offsets for the Game board print at top of screen P is for Player, C is for Computer
' S is for Ships Sunk tally on far right of screen (x,y) offsets:
Dim Shared As Long PXO, PYO, CXO, CYO, SXO, SYO
Dim Shared As Long PTurn, GameOn ' TF players turn or not and GameOn if still running game
' internal tracking of P() Players ships, C() Computer ships
Dim Shared As Long P(9, 9), C(9, 9), Hits(9, 9) ' player board, computer board and hits tracking for AI
Dim Shared As Long ShipLen(10), ShipHor(10), ShipX(10), ShipY(10), ShipSunk(10)
Dim Shared ShipName$(10), ShipHits$(10)
' Ship arrays are 0 based but are really numbered 1 to 10, 0 is ignored
' ShipName$() are names of ships according to length in character cells see approx line 38
' ShipLen() is the length or how many character cells a ship is long, 5 down to 2 according to index
' ShipHor() is a T/F value (0|-1) if it is Setup horizontal see SetUp where ships are positioned
' ShipX() and ShipY() locate the top of a ship if vertically set or the left start of ship if horizontal
' ShipHits$() tracks which cell on each ship was hit
' ShipSunk() T/F if ship has been sunk
' this stuff is for the AI for computer's turn to play
Dim Shared AiShots$(50) ' AiShots sequence pattern coverage of board when c not working a hit
Dim Shared As Long AiI ' index for AiShots$()
Dim Shared As Long Dir ' for AI bombing testing 4 directions from last hit for more of ship hit
Dim Shared As Long CurrentHits ' tracks how many hits have been made
' when ship is sunk subtract it's length
Dim Shared As Long X1, Y1, BombX, BombY, Hit2 ' tracking bombs and hits for AI to sink ship
' X1, Y1 is the location of the latest hit on ship
' Bombx, Bomby is next bomb location when working a first hit
' hit2 indicates the direction we are going was success on last hit
Color 15, 9
Randomize Timer
' set one time only stuff
PXO = 8: PYO = 6 ' offsets for player grid display, tracks players ships and computers shots
CXO = 35: CYO = 6 ' offsets for computer grid display, player shots hit= X miss= o
SXO = 68: SYO = 10 ' offsets ships sunk tally
For i = 1 To 10
Select Case i
Case 1: ShipLen(i) = 5: ShipName$(i) = "Carrier"
Case 2: ShipLen(i) = 4: ShipName$(i) = "Battleship"
Case 3: ShipLen(i) = 3: ShipName$(i) = "Cruiser"
Case 4: ShipLen(i) = 3: ShipName$(i) = "Submarine"
Case 5: ShipLen(i) = 2: ShipName$(i) = "Destroyer"
Case 6: ShipLen(i) = 5: ShipName$(i) = "Carrier"
Case 7: ShipLen(i) = 4: ShipName$(i) = "Battleship"
Case 8: ShipLen(i) = 3: ShipName$(i) = "Cruiser"
Case 9: ShipLen(i) = 3: ShipName$(i) = "Submarine"
Case 10: ShipLen(i) = 2: ShipName$(i) = "Destroyer"
End Select
Next
While 1 'run game loop until player quits
Setup
Shoot
Wend
Sub Setup ' get a game ready to play
' clear shared arrays and variables
Erase ShipX, ShipY, ShipHor, ShipHits$, ShipSunk, P, C, Hits
PTurn = 0: GameOn = 0: Dir = 0: AiI = 0: CurrentHits = 0 ' globals
'setup 2 bombing patterns to cover sea in checkerboard pattern one is chosen in each game
s1$ = "A0B1C2D3E4F5G6H7I8J9I0J1A8B9E0F1G2H3I4J5A4B5C6D7E8F9C0D1E2F3G4H5I6J7A6B7C8D9G0H1I2J3A2B3C4D5E6F7G8H9"
s2$ = "A9B8C7D6E5F4G3H2I1J0B0A1I9J8A5B4C3D2E1F0E9F8G7H6I5J4A3B2C1D0A7B6C5D4E3F2G1H0C9D8E7F6G5H4I3J2G9H8I7J6"
'If Rnd < .5 Then shots$ = s1$ Else shots$ = s2$ ' don't be predictable with bombing patterns
shots$ = s1$
' shuffle sections: priority diagonal then sub diagonals, Mod 8 then mod 4 then mod 2
ReDim As Long T(50), i
For i = 1 To 50: T(i) = i: Next ' don't shuffle want to test with predictable bombing
'start = 1: stp = 10: Shuffle T(), start, stp
'start = 11: stp = 14: Shuffle T(), start, stp
'start = 15: stp = 26: Shuffle T(), start, stp
'start = 27: stp = 50: Shuffle T(), start, stp
For i = 1 To 50 ' stow into an array
AiShots$(i) = Mid$(shots$, 2 * T(i) - 1, 2)
Next
Cls
' Game Board draw once per game
Print ""
Print " Player Computer"
Print ""
Print " A B C D E F G H I J A B C D E F G H I J"
Print " ------------------- -------------------"
Print " 0| . . . . . . . . . . 0| . . . . . . . . . ."
Print " 1| . . . . . . . . . . 1| . . . . . . . . . ."
Print " 2| . . . . . . . . . . 2| . . . . . . . . . ."
Print " 3| . . . . . . . . . . 3| . . . . . . . . . . Ships: P C"
Print " 4| . . . . . . . . . . 4| . . . . . . . . . . Carrier . ."
Print " 5| . . . . . . . . . . 5| . . . . . . . . . . Battleship . ."
Print " 6| . . . . . . . . . . 6| . . . . . . . . . . Cruiser . ."
Print " 7| . . . . . . . . . . 7| . . . . . . . . . . Submarine . ."
Print " 8| . . . . . . . . . . 8| . . . . . . . . . . Destroyer . ."
Print " 9| . . . . . . . . . . 9| . . . . . . . . . ."
Print " ------------------- -------------------"
Print " A B C D E F G H I J A B C D E F G H I J"
'locate 6, 5: print "X" ' check offsets
' debugg check AIshots$((aiI) OK
'For i = 1 To 50 'double check checker board coverage 50 cells in priority order
' x = InStr("ABCDEFGHIJ", Left$(AiShots$(i), 1)) - 1
' y = Val(Mid$(AiShots$(i), 2, 1))
' LP x, y, "p", "O"
' _Delay 1
'Next
For i = 1 To 10 ' restring ship hits to all clear no hits
ShipHits$(i) = String$(ShipLen(i), "o")
Next
Autosetup 1 'setup the Computers ships offer to that for player
View Print 20 To 25
Print " Let computer setup your ships? press y for yes, n for no..."
k$ = UCase$(Input$(1))
Cls
View Print
If k$ = "Y" Then
Autosetup 0
Else
For s = 1 To 5 ' do it yourself ship placement
OK = 0
While OK = 0
placeAgain:
View Print 20 To 25
Print " Setting up the " + ShipName$(s) + " with length" + Str$(ShipLen(s))
Print " To place ship:"
Print " Enter v for vertical, h for horizontal, letter and digit for top, left of ship"
Input " Placement "; place$
Cls
View Print ' turn off view
place$ = UCase$(place$)
' check place
If Left$(place$, 1) <> "V" And Left$(place$, 1) <> "H" Then Beep: GoTo placeAgain
sx = InStr("ABCDEFGHIJ", Mid$(place$, 2, 1))
If sx < 1 Or sx > 10 Then Beep: GoTo placeAgain Else sx = sx - 1
sy = InStr("0123456789", Mid$(place$, 3, 1))
If sy < 1 Or sy > 10 Then Beep: GoTo placeAgain Else sy = sy - 1
If Left$(place$, 1) = "V" Then ShipHor(s) = 0 Else ShipHor(s) = 1
If ShipHor(s) Then ' layout ship horiz
If sx <= 10 - ShipLen(s) Then
OK = 1
For xx = 0 To ShipLen(s) - 1
If P(sx + xx, sy) <> 0 Then OK = 0: Exit For
Next
If OK Then
ShipX(s) = sx: ShipY(s) = sy
For xx = 0 To ShipLen(s) - 1
P(sx + xx, sy) = s
LP sx + xx, sy, "p", _Trim$(Str$(s))
Next
End If
End If
Else ' layout vertical
If sy <= 10 - ShipLen(s) Then
OK = 1
For yy = 0 To ShipLen(s) - 1
If P(sx, sy + yy) <> 0 Then OK = 0: Exit For
Next
If OK Then
ShipX(s) = sx: ShipY(s) = sy
For yy = 0 To ShipLen(s) - 1
P(sx, sy + yy) = s
LP sx, sy + yy, "p", _Trim$(Str$(s))
Next
End If
End If
End If
Wend
Next
End If
End Sub
Sub Autosetup (AItf As Long)
If AItf Then 'setup Computer's ships
'setup a board with ships, Computer or AI's setup
For s = 6 To 10
OK = 0
While OK = 0
ShipHor(s) = Rand(0, 1)
If ShipHor(s) Then
sy = Rand(0, 9)
sx = Rand(0, 10 - ShipLen(s))
OK = 1
For xx = 0 To ShipLen(s) - 1
If C(sx + xx, sy) <> 0 Then OK = 0: Exit For
Next
If OK Then
ShipX(s) = sx: ShipY(s) = sy
For xx = 0 To ShipLen(s) - 1
C(sx + xx, sy) = s
'LP sx + xx, sy, "c", _Trim$(Str$(S Mod 10)) ' for debugg
Next
End If
Else
sx = Rand(0, 9)
sy = Rand(0, 10 - ShipLen(s))
OK = 1
For yy = 0 To ShipLen(s) - 1
If C(sx, sy + yy) <> 0 Then OK = 0: Exit For
Next
If OK Then
ShipX(s) = sx: ShipY(s) = sy
For yy = 0 To ShipLen(s) - 1
C(sx, sy + yy) = s
'LP sx, sy + yy, "c", _Trim$(Str$(S Mod 10)) ' for debugg
Next
End If
End If
Wend
Next
Else 'setup Player's ships
For s = 1 To 5
OK = 0
While OK = 0
ShipHor(s) = Rand(0, 1)
If ShipHor(s) Then
sy = Rand(0, 9)
sx = Rand(0, 10 - ShipLen(s))
OK = 1
For xx = 0 To ShipLen(s) - 1
If P(sx + xx, sy) <> 0 Then OK = 0: Exit For
Next
If OK Then
ShipX(s) = sx: ShipY(s) = sy
For xx = 0 To ShipLen(s) - 1
P(sx + xx, sy) = s
LP sx + xx, sy, "p", _Trim$(Str$(s))
Next
End If
Else
sx = Rand(0, 9)
sy = Rand(0, 10 - ShipLen(s))
OK = 1
For yy = 0 To ShipLen(s) - 1
If P(sx, sy + yy) <> 0 Then OK = 0: Exit For
Next
If OK Then
ShipX(s) = sx: ShipY(s) = sy
For yy = 0 To ShipLen(s) - 1
P(sx, sy + yy) = s
LP sx, sy + yy, "p", _Trim$(Str$(s))
Next
End If
End If
Wend
Next
End If
End Sub
Sub FYI (Info$) ' in place of a MessageBox
Sound 3000, 4
Color 10, 1
View Print 20 To 25
Print Space$(3); Info$ + " ...zzz"
Sleep 3
Cls
View Print
Color 15, 1
End Sub
Sub LP (x As Long, y As Long, pcGrid$, s$)
If pcGrid$ = "p" Then Locate PYO + y, PXO + 2 * x Else Locate CYO + y, CXO + 2 * x
Print s$;
End Sub
Function Rand& (low As Long, high As Long) ' Random integer from low to high inclusive
Rand& = Int(Rnd * (high - low + 1)) + low
End Function
Sub Shoot
GameOn = 1
While GameOn
'If PTurn Then PTurn = 0 Else PTurn = 1
PTurn = 0 ' for the AI Movie
If PTurn Then ' player
playerAgain:
View Print 20 To 25
Input " Enter your next bomb site letter digit "; place$
Cls
View Print
If place$ = "" Then GameOn = 0
place$ = UCase$(place$)
bx = InStr("ABCDEFGHIJ", Left$(place$, 1)) - 1
by = Val(Mid$(place$, 2, 1))
If bx >= 0 And bx < 10 Then ' better check
If by >= 0 And by < 10 Then
If C(bx, by) = 0 Then 'miss
LP bx, by, "c", "o"
C(bx, by) = -1
ElseIf C(bx, by) > 5 And C(bx, by) < 11 Then 'hit
LP bx, by, "c", "X"
Sound 200, 2
HitEval "c", bx, by 'game could end here
C(bx, by) = C(bx, by) + 10 ' signal we hit this spot already!
ElseIf C(bx, by) = -1 Or C(bx, by) > 10 Then
Beep: GoTo playerAgain
End If
End If
End If
Else
'AI's turn if it gets a hit it will bomb around the ship until it is finished
'could be trouble if 2 ships are next to each other. Some effort to work it,
'still might get confused.
'hits() array tracks red = 1 and white pegs = -1 like a human player for AI
If Dir Then 'we are working around the latest hit with bombx, bomby to test
If P(BombX, BombY) <> 0 Then 'hit!
Hit2 = 1 ' found 2nd hit neighbor of first hi could be another ship
Hits(BombX, BombY) = 1: CurrentHits = CurrentHits + 1
LP BombX, BombY, "p", "X"
'when hitEval announces a ship sunk we can reduce the currentHits count
'by that ships amount if still have more current hits, continue bombing
' area as another ship is there
Sound 2000, 2 ' wakeup player!
HitEval "p", BombX, BombY ' this will reduce currentHits by the amount
' a ship would take when sunk
If CurrentHits = 0 Then ' clear our checklist we sank all ships we hit,
' call off bombing of area
X1 = 0: Y1 = 0: Dir = 0
Else
DecideWhereToBombNext
End If
Else 'no hit from checklist scratch off one item
Hit2 = 0
Hits(BombX, BombY) = -1
LP BombX, BombY, "p", "o"
DecideWhereToBombNext
End If ' are we still working on hit
Else
'not working on any hits x1, y1 = 0, dir = 0, currentHits might be = 0
'random but systematic shooting, bring up next good shooting location
alreadyHit:
AiI = AiI + 1 ' next random shoot
If AiI > 50 Then ' we should never get this far but just in case
x = Rand(0, 9)
y = Rand(0, 9)
Else ' normal shooting pattern by diagonals to form checker board coverage
x = InStr("ABCDEFGHIJ", Left$(AiShots$(AiI), 1)) - 1
y = Val(Mid$(AiShots$(AiI), 2, 1))
End If
If Hits(x, y) <> 0 Then GoTo alreadyHit
' was that shot just fired a hit or miss
If P(x, y) <> 0 Then ' test our shot just fired is hit!
X1 = x: Y1 = y 'save first hit to come back to
Hits(X1, Y1) = 1: CurrentHits = CurrentHits + 1
LP X1, Y1, "p", "X"
Sound 2000, 2 ' wakeup player!
HitEval "p", X1, Y1
'did we just happen to finish off a ship? current hits = 0
If CurrentHits = 0 Then 'must of finished off an ship
X1 = 0: Y1 = 0: Dir = 0 'we are done
Else
Dir = -1 ' this signals we are working on a hit
DecideWhereToBombNext
End If
Else 'no hit
Hits(x, y) = -1
LP x, y, "p", "o"
End If
End If 'rI was hit or not
End If 'whose turn is it
_Delay 1 ' a sec pause to allow us to see computers move
Wend
View Print 20 To 25
Print " Play Again? press y for yes, n for no..."
k$ = Input$(1)
Cls
View Print
If k$ = "n" Then End
End Sub
Sub HitEval (board$, bbx, bby)
'this is like a referee for both players to announce a ship sunk and a game won?
If board$ <> "p" Then
s = C(bbx, bby) ' which ship number
you$ = "Player": my$ = "Computer's"
istart = 6: istop = 10
Else
s = P(bbx, bby)
you$ = "Computer": my$ = "Player's"
istart = 1: istop = 5
End If
If ShipHor(s) Then D = bbx - ShipX(s) + 1 Else D = bby - ShipY(s) + 1
Mid$(ShipHits$(s), D, 1) = "X"
If ShipHits$(s) = String$(ShipLen(s), "X") Then
ShipSunk(s) = 1
If board$ = "p" Then CurrentHits = CurrentHits - ShipLen(s)
UpdateStatus
FYI "Congrats: " + you$ + " sank " + my$ + " " + ShipName$(s) + "!"
tot = 0
For i = istart To istop
If ShipSunk(i) = 1 Then tot = tot + 1
Next
If tot = 5 Then
UpdateStatus
If you$ = "Computer" Then ShowComputersShips
FYI "Congrats: " + you$ + ", you sank all " + my$ + " ships! Game Over"
GameOn = 0
End If
End If
End Sub
Sub DecideWhereToBombNext
'find next good location, mark the direction we took
If Dir = -1 Then ' new hit
Hit2 = 0 'when direction = 0 reset 2nd hit signal to 0
If X1 + 1 <= 9 Then
If Hits(X1 + 1, Y1) = 0 Then
BombX = X1 + 1: BombY = Y1: Dir = 1: Exit Sub
End If
End If
'still here?
If Y1 + 1 <= 9 Then
If Hits(X1, Y1 + 1) = 0 Then
BombX = X1: BombY = Y1 + 1: Dir = 2: Exit Sub
End If
End If
'still here?
If X1 - 1 >= 0 Then
If Hits(X1 - 1, Y1) = 0 Then
BombX = X1 - 1: BombY = Y1: Dir = 3: Exit Sub
End If
End If
'still here OK this has to do it!
If Y1 - 1 >= 0 Then
If Hits(X1, Y1 - 1) = 0 Then
BombX = X1: BombY = Y1 - 1: Dir = 4: Exit Sub
End If
End If
'still here ???? damn! give up and go back to random shots
Dir = 0: Exit Sub ' < this signals that
End If
'setup next bombx, bomby
If Hit2 Then 'whatever direction we are taking, continue if we can
Select Case Dir
Case 1
If BombX + 1 <= 9 Then
If Hits(BombX + 1, BombY) = 0 Then
BombX = BombX + 1: Exit Sub
End If
End If
Case 2
If BombY + 1 <= 9 Then
If Hits(BombX, BombY + 1) = 0 Then
BombY = BombY + 1: Exit Sub
End If
End If
Case 3
If BombX - 1 >= 0 Then
If Hits(BombX - 1, BombY) = 0 Then
BombX = BombX - 1: Exit Sub
End If
End If
Case 4
If BombY - 1 >= 0 Then
If Hits(BombX, BombY - 1) = 0 Then
BombY = BombY - 1: Dir = 4: Exit Sub
End If
End If
End Select
End If
'still here? then we have to change direction and go back to x1, y1 the first hit
Hit2 = 0 'reset this for the new direction check
While Dir < 4
Dir = Dir + 1
Select Case Dir
Case 2
If Y1 + 1 <= 9 Then
If Hits(X1, Y1 + 1) = 0 Then
BombX = X1: BombY = Y1 + 1: Exit Sub
End If
End If
Case 3
If X1 - 1 >= 0 Then
If Hits(X1 - 1, Y1) = 0 Then
BombX = X1 - 1: BombY = Y1: Exit Sub
End If
End If
Case 4
If Y1 - 1 >= 0 Then
If Hits(X1, Y1 - 1) = 0 Then
BombX = X1: BombY = Y1 - 1: Exit Sub
End If
End If
End Select
Wend
'still here, well we've run out of directions
Dir = 0 'back to random bombing
End Sub
Sub UpdateStatus ' ships area
For i = 1 To 5 ' row 10 carrier player colum 66 computer column 68
If ShipSunk(i) Then Locate i + 9, 68,: Print "X";
If ShipSunk(i + 5) Then Locate i + 9, 70: Print "X"
Next
End Sub
Sub ShowComputersShips ' fixed this so only empty spaces not bombed are displayed
For s = 6 To 10
If ShipHor(s) Then
sx = ShipX(s): sy = ShipY(s)
For xx = 0 To ShipLen(s) - 1
If Mid$(ShipHits$(s), xx + 1, 1) = "o" Then
LP sx + xx, sy, "c", _Trim$(Str$(s Mod 10))
End If
Next
Else
sx = ShipX(s): sy = ShipY(s)
For yy = 0 To ShipLen(s) - 1
If Mid$(ShipHits$(s), yy + 1, 1) = "o" Then
LP sx, sy + yy, "c", _Trim$(Str$(s Mod 10))
End If
Next
End If
Next
End Sub
Sub Shuffle (a() As Long, start, stp) ' used to randomize shooting pattern a bit
For i = stp To start + 1 Step -1
Swap a(i), a(Rand(start, i))
Next
End SubAlso makes a great tool to test and improve the AI with tricky ship positioning in attempts to befuddle the AI.
b = b + ...