02-14-2023, 07:53 PM
This snake finds the food fast enough and does alright finding a path to the food until...
his own body blocks the way between head and food.
his own body blocks the way between head and food.
Code: (Select All)
Option _Explicit
_Title "Snake AI-1_7 Real AI" 'b+ 2020-03-20 and Ashish SUB snakeBrainAshish1
'2020-03-14 Snake AI-1 first post
'2020-03-16 Snake AI-1_1 there must be overlap of the snake somewhere! Aha!
'2020-03-17 Snake AI-1_2 fix the duplicate segment problem
' Now a new mystery, an ocassional flashing duplicate box
'2020-03-17 Install standard snake rules for testing brain evolving
' First setup XY type and rename and convert variables using XY type.
' 2nd Make snake brain and whole game only dependent sqrsX, sqrsY and sq for screen size
' Got it!!! the code ends with hangup head next to fruit with 99 (1 cell less that whole board)
' cells of snake length, no new place can be found for fruit, perfect finish and no duplicate
' cells! PLUS now can turn on a dime go up one colume and down the next in 2 key press.
' Now add autoPilot on -1 / off 0 toggle control, OK snake rules tested when human pilots snake.
' Help screen & independent speeds for human or AI.
'2020-03-18 "Snake AI-1_4 fix tester" The AI tester needs to save Head(x, y) in case the AI
' does not change the head(x, y) or tries to move it diagonally.
'2020-03-18 Snake AI-1_5 SHARE change AS XY
' DIM SHARE change AS XY or change.x, change.y replaces variables called dx, dy.
' I decided to switch over to human control if AI fails to return a proper change.
' AI must leave change.x, change.y ready for human to take over control which means my changing
' the code for toggling the autopilot and adding change.x, change.y updates in my snakeBrain SUB.
' Rewrite SnakeBrain using only change.X and change.Y now. A BEEP will indicate an AI error and
' signal control returned to human. This noted in Key Help part of screen.
'2020-03-19 Snake AI-1_6 B+brain#2 begin a new snakeBrainBplus2 sub routine
' Add a driver report in title bar along with sLen.
' Oh hey what a fancy snake dance, not the least bit faster than snakeBrainBplus1.
'2020-03-20 Snake AI-1_7 real AI
' RE: snakeBrainBplus2
' Recode snakeBrainBplus2 to be self contained in one SUB, load data for the array it uses inside
' that SUB. It also has to check sqrsX, sqrsY to be sure they are correct, this is pure novelty
' SUB so will set sqrsX, sqrsY back to 20 each for standard game AI setting. OK good!
' RE: sqrsX, sqrsY
' sqrsX, sqrsY reset back to 20, 20 for standard setup for testing AI.
' RE: Ashish first "real AI" very excellent submission!
' Attempt to incorporate Ashish "real AI" as SUB snakeBrainAshish1
' Ashish is using $CONSOLE and DIM SHARED state$ but I don't see why so I made state$ STATIC in
' his SUB and took console out, though I can see it might be needed later. Working here yeah!
' RE: SnakeBrainBplus3, bplus first "real AI" also working pretty well to a point.
' SnakeBrainBplus3 uses real AI and crashes when snake can't get to fruit due to it's length
' either by inaccessible fruit, snakes body blocks head or head buried in body and can't escape.
' Using lessons learned from Pathfinder work.
' Snakepit Dimensions: square size = sq, sqrsX = # of squares along x-axis and sqrsY squares down.
Const sq = 20, sqrsX = 20, sqrsY = 20, xmax = sq * sqrsX, ymax = sq * sqrsY
Screen _NewImage(800, 600, 32)
_Delay .25
_ScreenMove _Middle
Randomize Timer
'Usually used to give a point on 2D board a single name that has an X dimension and a Y dimension.
Type XY
X As Integer
Y As Integer
End Type
' SHARED variables for any version of SnakeBrain SUB to act as autoPilot for snake snake.
Dim Shared change As XY ' directs the head direction through AI or Human
Dim Shared head As XY ' leads the way of the snake(body) through snakepit
Dim Shared sLen As Integer ' length of snake
Dim Shared snake(1 To sqrsX * sqrsY) As XY ' whole snake, head is at index = sLen
Dim Shared fruit As XY ' as snake eats fruit it grows, object is to grow snake to fill snakepit
' SHARED for screenUpdate
Dim Shared pal(sqrsX * sqrsY) As _Unsigned Long ' for snake colors
'other data needed for program
Dim i As Integer, good As Integer, KEY$, r As Integer, g As Integer, b As Integer
Dim autoPilot As Integer, hSpeed, aSpeed, saveChange As XY, title$
help ' Key Menu
hSpeed = 3: aSpeed = 20 ' autopilot speed is independent of human control speed
restart: ' reinitialize
r = .3 + Rnd * .7: g = r * .5 + Rnd * .3 - .15: b = .5 * r + Rnd * .3 - .15 ' rnd pal color vars
For i = 1 To sqrsX * sqrsY ' enough colors for snake to fill snakepit
pal(i) = _RGB32(84 + 64 * Sin(r + i / 2), 84 + 64 * Sin(g + i / 2), 104 * Sin(b + i / 2))
Next
head.X = sqrsX / 2 - 3: head.Y = sqrsY / 2 - 3 ' head start
fruit.X = sqrsX / 2 + 2: fruit.Y = sqrsY / 2 + 2 ' first fruit
sLen = 1 ' for starters snake is all head
snake(sLen).X = head.X: snake(sLen).Y = head.Y ' head is always at sLen end
autoPilot = 1 ' start snake body count
change.X = 0: change.Y = 1 ' head snake down board, Y direction of first fruit
Do
If autoPilot Then title$ = "AI." Else title$ = "human."
_Title Str$(sLen) + " Current driver is " + title$
Line (0, 0)-(xmax, ymax), &HFF884422, BF ' clear snakepit
If sLen = sqrsX * sqrsY - 1 Then screenUpdate: Exit Do ' game is won! start another
KEY$ = InKey$
If KEY$ = "q" Or KEY$ = Chr$(27) Then ' here is quit
End '
ElseIf KEY$ = "a" Then ' toggle autoPilot
autoPilot = 1 - autoPilot ' it is now up to AI to keep change updated for human take over
ElseIf KEY$ = "p" Then ' pause toggle p starts pause p ends pause
_KeyClear: While InKey$ <> "p": _Limit 60: Wend
ElseIf KEY$ = "s" Then
If autoPilot And aSpeed + 5 < 400 Then aSpeed = aSpeed + 5 'max autopilot speed is 400 !!!
If autoPilot = 0 And hSpeed + .5 < 10 Then hSpeed = hSpeed + .5 ' max human speed is 10
ElseIf KEY$ = "-" Then
If autoPilot And aSpeed - 5 > 0 Then aSpeed = aSpeed - 5
If autoPilot = 0 And hSpeed - .5 > 1 Then hSpeed = hSpeed - .5
End If ' '
If autoPilot Then ' who is piloting the snake?
saveChange.X = change.X: saveChange.Y = change.Y ' if AI screws up then human takes over
' PLUG-IN YOUR Snake Brain AI here
'=========================================================================== AI Auto Pilot
'snakeBrainBplus1 ' dumb track AI but always gets it's fruit! requires even # sqrsX
'sqrsX = 17: sqrsY = 16
'snakeBrainBplus2 ' dumb track AI but looks cool! requires custom sqrsX = 17, sqrsY = 16
'snakeBrainAshish1 ' first "realAI" I would call an heuristic approach, thanks Ashish!
snakeBrainBplus3 ' bplus "first real AI" uses modified Pathfinder methods
'=========================================================================================
'check changes
If Abs(change.X) = 0 Then ' must have diffence in y's
If Abs(change.Y) <> 1 Then autoPilot = 0 ' error switch to human
ElseIf Abs(change.Y) = 0 Then
If Abs(change.X) <> 1 Then autoPilot = 0 ' error switch to human
Else ' must have a 0 in either change.x or change.y but not both
autoPilot = 0 ' error switch to human
End If
If autoPilot = 0 Then ' switching control over to human restore change values
change.X = saveChange.X: change.Y = saveChange.Y: Beep ' alert human
End If
Else ' ======================================================================= human control
If KEY$ = Chr$(0) + Chr$(72) Then ' up arrow
change.X = 0: change.Y = -1
ElseIf KEY$ = Chr$(0) + Chr$(80) Then ' down arrow
change.X = 0: change.Y = 1
ElseIf KEY$ = Chr$(0) + Chr$(77) Then ' right arrow
change.X = 1: change.Y = 0
ElseIf KEY$ = Chr$(0) + Chr$(75) Then ' left arrow
change.X = -1: change.Y = 0
End If
End If
head.X = head.X + change.X: head.Y = head.Y + change.Y ' OK human or AI have spoken
' ============================ check snake head with Rules: ===============================
' 1. Snakepit boundary check, snake hits wall, dies.
If head.X < 0 Or head.X > sqrsX - 1 Or head.Y < 0 Or head.Y > sqrsY - 1 Then
_Title _Trim$(Str$(sLen)) + " Wall Crash": screenUpdate: Exit Do ' wall crash, new game
End If
' 2. Snake eats body part, dies. This should kill snake if turn its head back on itself.
For i = 1 To sLen ' did head just crash into body?
If head.X = snake(i).X And head.Y = snake(i).Y Then
_Title _Trim$(Str$(sLen)) + " Body Crash": screenUpdate: Exit Do ' yes! start new game
End If
Next ' no
' 3. Eats Fruit and grows or just move every segment up 1 space.
If (fruit.X = head.X And fruit.Y = head.Y) Then ' snake eats fruit
sLen = sLen + 1
snake(sLen).X = head.X: snake(sLen).Y = head.Y 'assimilate fruit into head for new segment
Do 'check new apple
fruit.X = Int(Rnd * sqrsX): fruit.Y = Int(Rnd * sqrsY): good = -1
For i = 1 To sLen
If fruit.X = snake(i).X And fruit.Y = snake(i).Y Then good = 0: Exit For
Next
Loop Until good
Else
For i = 1 To sLen ' move the snake data down 1 dropping off last
snake(i).X = snake(i + 1).X: snake(i).Y = snake(i + 1).Y
Next
snake(sLen).X = head.X: snake(sLen).Y = head.Y ' and adding new head position
End If
screenUpdate ' on with the show this is it!
If autoPilot Then _Limit aSpeed Else _Limit hSpeed 'independent speed control for human and AI
Loop
_Delay 4 ' win or loose, go again
GoTo restart:
Sub screenUpdate ' draw snake and fruit, overlap code debugger
Dim c~&, i As Integer, overlap(sqrsX, sqrsY) As Integer
For i = 1 To sLen
If i = sLen Then c~& = &HFF000000 Else c~& = pal(sLen - i)
' overlap helps debug duplicate square drawing which indicates a flawed code
overlap(snake(i).X, snake(i).Y) = overlap(snake(i).X, snake(i).Y) + 1
Line (snake(i).X * sq, snake(i).Y * sq)-Step(sq - 2, sq - 2), c~&, BF
If overlap(snake(i).X, snake(i).Y) > 1 Then 'show visually where code flaws effect display
LINE (snake(i).X * sq + .25 * sq, snake(i).Y * sq + .25 * sq)_
-STEP(.5 * sq - 2, .5 * sq - 2), &HFFFFFFFF, BF
End If
Next
Line (fruit.X * sq, fruit.Y * sq)-Step(sq - 2, sq - 2), _RGB32(255, 100, 255), BF
_Display
End Sub
Sub help
_PrintString (610, 20), "Keys:"
_PrintString (610, 40), "p toggles pause on/off"
_PrintString (610, 60), "a toggles autoPilot"
_PrintString (610, 100), "arrows control snake"
_PrintString (610, 80), "q or esc quits"
_PrintString (610, 120), "s increases speed"
_PrintString (610, 140), "- decreases speed"
_PrintString (610, 200), "A BEEP means AI error,"
_PrintString (610, 216), "human put in control."
End Sub
'basic functions added for snakeBrainBplus3 (bplus first real AI)
Function max (n As Integer, m As Integer)
If n > m Then max = n Else max = m
End Function
Function min (n As Integer, m As Integer)
If n < m Then min = n Else min = m
End Function
' ================================================================= end code that runs Snake Games
Sub snakeBrainBplus1 '>>>>>>>>>> B+ SNAKE BRAIN needs sqrsX to be even number <<<<<<<<<<<<<<<
' This will be handy for standard 20x20 snakepit to dove tail real AI towrds.
'todo fix this so that when takeover control won't crash into self
If sqrsX Mod 2 = 1 Then change.X = 0: change.Y = 0: Exit Sub ' throw error for code check to
' discover and switch to human control
If head.X = 0 And head.Y = sqrsY - 1 Then
change.X = 0: change.Y = -1
ElseIf head.X Mod 2 = 0 And head.Y <> 0 And head.Y <> sqrsY - 1 Then
change.X = 0: change.Y = -1
ElseIf head.X Mod 2 = 0 And head.Y = 0 And head.Y <> sqrsY - 1 Then
change.X = 1: change.Y = 0
ElseIf head.X Mod 2 = 1 And head.X <> sqrsX - 1 And head.Y = sqrsY - 2 Then
change.X = 1: change.Y = 0
ElseIf head.X Mod 2 = 1 And head.X <> sqrsX - 1 And head.Y < sqrsY - 1 Then
change.X = 0: change.Y = 1
ElseIf head.X = sqrsX - 1 And head.Y = sqrsY - 1 Then
change.X = -1: change.Y = 0
ElseIf head.Y = sqrsY - 1 And head.X <> 0 Then
change.X = -1: change.Y = 0
ElseIf head.X Mod 2 = 1 And head.Y = 0 And head.Y <> sqrsY - 1 Then
change.X = 0: change.Y = 1
ElseIf head.X = sqrsX - 1 And head.Y < sqrsY - 1 Then
change.X = 0: change.Y = 1
End If
End Sub
Sub snakeBrainBplus2 ' Needs custom sqrsX = 17, sqrsY = 16 This is mainly a novelty SUB for fun!
'A good AI will NOT require a custom sqrsX = 17, sqrsY = 16
If sqrsX <> 17 Or sqrsY <> 16 Then change.X = 0: change.Y = 0: Exit Sub ' throw error for code
' check to discover and switch to human control
Dim x, y, s$, direction$
Static brain2Directions(sqrsX - 1, sqrsY - 1) As String
If brain2Directions(0, 0) <> "R" Then GoSub loadBrain2Directions 'array not loaded yet so load
direction$ = brain2Directions(head.X, head.Y)
Select Case direction$
Case "U": change.X = 0: change.Y = -1
Case "D": change.X = 0: change.Y = 1
Case "L": change.X = -1: change.Y = 0
Case "R": change.X = 1: change.Y = 0
End Select
Exit Sub
loadBrain2Directions:
For y = 0 To sqrsY - 1
Read s$
For x = 0 To sqrsX - 1
brain2Directions(x, y) = Mid$(s$, x + 1, 1)
Next
Next
Return
Data RRRRRRRRRRRRRRRRD
Data UDLLLLLLLLLLLLLLD
Data UDRRRRRRRRRRRRDUD
Data UDUDLLLLLLLLLLDUD
Data UDUDRRRRRRRRDUDUD
Data UDUDUDLLLLLLDUDUD
Data UDUDUDRRRRDUDUDUD
Data UDUDUDUDLLDUDUDUD
Data UDUDUDUDRUDUDUDUD
Data UDUDUDUDULLUDUDUD
Data UDUDUDURRRRUDUDUD
Data UDUDUDULLLLLLUDUD
Data UDUDURRRRRRRRUDUD
Data UDUDULLLLLLLLLLUD
Data UDURRRRRRRRRRRRUD
Data ULULLLLLLLLLLLLLL
' note: I had the following lines in main code delares section in case OPTION _EXPLICIT
' started alerts about DIM the STATIC variable in main but not needed.
'
' I think OPTION _EXPLICIT requires next line but will make snakeBrainBplus2 self contained.
'DIM SHARED brain2Directions(0 TO sqrsX - 1, 0 TO sqrsY - 1) AS STRING ' 4 snakeBrainBplus2 AI
End Sub
Sub snakeBrainAshish1 'needs supplemental FUNCTION snakeBodyExists (which%)
Dim nx, ny, dx, dy 'Ashish AI
Static decided
Static state$ ' bplus added state$ to SUB here and removed from DIM SHARED in Main Declares
dx = fruit.X - head.X
dy = fruit.Y - head.Y
nx = snakeBodyExists(1)
ny = snakeBodyExists(2)
If sLen > 1 Then 'collison at corners of square
If head.X = 0 And head.Y = 0 Then
state$ = "corners"
If change.X = -1 Then change.X = 0: change.Y = 1: decided = 0: Exit Sub
If change.Y = -1 Then change.Y = 0: change.X = 1: decided = 0: Exit Sub
ElseIf head.X = 0 And head.Y = sqrsY - 1 Then
state$ = "corners"
If change.X = -1 Then change.X = 0: change.Y = -1: decided = 0: Exit Sub
If change.Y = 1 Then change.Y = 0: change.X = 1: decided = 0: decided = 0: Exit Sub
ElseIf head.X = sqrsX - 1 And head.Y = 0 Then
state$ = "corners"
If change.X = 1 Then change.X = 0: change.Y = 1: decided = 0: Exit Sub
If change.Y = -1 Then change.Y = 0: change.X = -1: decided = 0: Exit Sub
ElseIf head.X = sqrsX - 1 And head.Y = sqrsY - 1 Then
state$ = "corners"
If change.X = 1 Then change.X = 0: change.Y = -1: decided = 0: Exit Sub
If change.Y = 1 Then change.Y = 0: change.X = -1: decided = 0: Exit Sub
End If
If decided = 0 Then 'collision with walls
If head.X = sqrsX - 1 Or head.X = 0 Then
state$ = "walls"
If ny = 0 Then
If dy > 0 Then ny = -1 Else ny = 1
End If
change.Y = ny * -1: change.X = 0
decided = 1
Exit Sub
ElseIf head.Y = sqrsY - 1 Or head.Y = 0 Then
state$ = "walls"
If nx = 0 Then
If dx > 0 Then nx = -1 Else nx = 1
End If
change.X = nx * -1: change.Y = 0
decided = 1
Exit Sub
End If
End If
End If
If dx = 0 Then 'when fruit and head in same direction and motion in same axis
If change.Y = 0 Then
state$ = "linear"
If dy > 0 And ny <> 1 Then
change.Y = 1: change.X = 0: decided = 0: Exit Sub
ElseIf dy < 0 And ny <> -1 Then
change.Y = -1: change.X = 0: decided = 0: Exit Sub
End If
End If
End If
If dy = 0 Then
If change.X = 0 Then
state$ = "linear"
If dx > 0 And nx <> 1 Then
change.X = 1: change.Y = 0: decided = 0: Exit Sub
ElseIf dx < 0 And nx <> -1 Then
change.X = -1: change.Y = 0: decided = 0: Exit Sub
End If
End If
End If
state$ = "common"
'common decision
If Abs(dx) < Abs(dy) Then
state$ = "common ny=" + Str$(ny)
If ny = 0 Then
change.X = 0
If dy > 0 Then change.Y = 1 Else change.Y = -1
state$ = "common cy=" + Str$(change.Y)
Exit Sub
End If
If dy > 0 And ny <> 1 Then change.Y = 1: change.X = 0
If dy < 0 And ny <> -1 Then change.Y = -1: change.X = 0
decided = 0
Else
state$ = "common nx=" + Str$(nx)
If nx = 0 Then
change.Y = 0
If dx > 0 Then change.X = 1 Else change.X = -1
state$ = "common cx=" + Str$(change.X)
Exit Sub
End If
If dx > 0 And nx <> 1 Then change.X = 1: change.Y = 0
If dx < 0 And nx <> -1 Then change.X = -1: change.Y = 0
decided = 0
End If
state$ = "rand_common"
If Abs(dx) = Abs(dy) Then 'random choice will be made then, rest code is same as above
If Rnd > 0.5 Then
state$ = "rand_common ny=" + Str$(ny)
If ny = 0 Then
change.X = 0
If dy > 0 Then change.Y = 1 Else change.Y = -1
state$ = "rand_common cy=" + Str$(change.Y)
Exit Sub
End If
If dy > 0 And ny <> 1 Then change.Y = 1: change.X = 0
If dy < 0 And ny <> -1 Then change.Y = -1: change.X = 0
decided = 0
Else
state$ = "rand_common nx=" + Str$(nx)
If nx = 0 Then
change.Y = 0
If dx > 0 Then change.X = 1 Else change.X = -1
state$ = "rand_common cx=" + Str$(change.X)
Exit Sub
End If
If dx > 0 And nx <> 1 Then change.X = 1: change.Y = 0
If dx < 0 And nx <> -1 Then change.X = -1: change.Y = 0
decided = 0
End If
End If
End Sub
Function snakeBodyExists (which%) ' for SUB snakeBrainAshish1 supplemental
If sLen = 1 Then Exit Function
Dim n
For n = 1 To sLen - 1
If which% = 1 Then 'x-direction
If snake(n).X - head.X > 0 And snake(n).Y = head.Y Then snakeBodyExists = 1: Exit Function
If snake(n).X - head.X < 0 And snake(n).Y = head.Y Then snakeBodyExists = -1: Exit Function
ElseIf which% = 2 Then 'y-direction
If snake(n).Y - head.Y > 0 And snake(n).X = head.X Then snakeBodyExists = 1: Exit Function
If snake(n).Y - head.Y < 0 And snake(n).X = head.X Then snakeBodyExists = -1: Exit Function
End If
Next
End Function
Sub snakeBrainBplus3 ' real AI, responds to real time information
'needs FUNCTION max (n AS INTEGER, m AS INTEGER), FUNCTION min (n AS INTEGER, m AS INTEGER)
'from: Pathfinder inside Maze.bas B+ 2019-12-19 only completely overhauled!
Dim x As Integer, y As Integer, i As Integer, changeF As Integer
Dim parentF As Integer, tick As Integer, foundHead As Integer, headMarked As Integer
Dim yStart As Integer, yStop As Integer, xStart As Integer, xStop As Integer
Dim map(sqrsX - 1, sqrsY - 1) As String, map2(sqrsX - 1, sqrsY - 1) As String
For y = 0 To sqrsY - 1
For x = 0 To sqrsX - 1
map(x, y) = " "
Next
Next
For i = 1 To sLen - 1 ' draw snake in map
map(snake(i).X, snake(i).Y) = "S"
Next
map(head.X, head.Y) = "H"
map(fruit.X, fruit.Y) = "F"
tick = 0
While parentF Or headMarked = 0
parentF = 0: tick = tick + 1
yStart = max(fruit.Y - tick, 0): yStop = min(fruit.Y + tick, sqrsY - 1)
ReDim map2(sqrsX - 1, sqrsY - 1) As String ' need a 2nd map to hold all new stuff until
For y = 0 To sqrsY - 1 ' the entire square coverd
For x = 0 To sqrsX - 1
map2(x, y) = " "
Next
Next
For y = yStart To yStop
xStart = max(fruit.X - tick, 0): xStop = min(fruit.X + tick, sqrsX - 1)
For x = xStart To xStop
'check out the neighbors
If map(x, y) = " " Or map(x, y) = "H" Then
If map(x, y) = "H" Then foundHead = -1
If y - 1 >= 0 Then
If InStr("UDLRF", map(x, y - 1)) Then
map2(x, y) = "U": parentF = 1
If foundHead Then headMarked = -1
End If
End If
If y + 1 <= sqrsY - 1 Then
If InStr("UDLRF", map(x, y + 1)) Then
map2(x, y) = "D": parentF = 1
If foundHead Then headMarked = -1
End If
End If
If x + 1 <= sqrsX - 1 Then
If InStr("UDLRF", map(x + 1, y)) Then
map2(x, y) = "R": parentF = 1
If foundHead Then headMarked = -1
End If
End If
If x - 1 >= 0 Then
If InStr("UDLRF", map(x - 1, y)) Then
map2(x, y) = "L": parentF = 1
If foundHead Then headMarked = -1
End If
End If
End If
Next
Next
For y = 0 To sqrsY - 1 'transfer data to map
For x = 0 To sqrsX - 1
If map2(x, y) <> " " Then map(x, y) = map2(x, y): changeF = 1
Next
Next
Wend 'if no ParentF then dead connection to Fruit
Select Case map(head.X, head.Y)
Case "H" ' cause crash because no connection to fruit found
If change.X Then change.X = -change.X Else change.Y = -change.Y 'make Body crash
' change.X = 0: change.Y = 0 ' this will switch auto control off to avoid program hang, dang still hangs!
Case "D": change.X = 0: change.Y = 1
Case "U": change.X = 0: change.Y = -1
Case "R": change.X = 1: change.Y = 0
Case "L": change.X = -1: change.Y = 0
End Select
End Sub
b = b + ...