QB64 Phoenix Edition
Smarter than a fb Worm - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Smarter than a fb Worm (/showthread.php?tid=1471)



Smarter than a fb Worm - bplus - 02-13-2023

This snake never goes hungry:
Code: (Select All)
_Title "Snake AI-1.1" 'b+ 2020-03-16
'2020-03-14 Snake AI-1 first post
'2020-03-16  Snake AI-1.1 there must be overlap of the snake somewhere!

Const sq = 20, sqs = 20, xmax = 400, ymax = 400
Screen _NewImage(xmax, ymax, 32)
_Delay .25
_ScreenMove _Middle
Randomize Timer
Dim X(xmax + 100), Y(ymax + 100), overlap(19, 19) As Integer
hx = 10: hy = 10: ax = 15: ay = 15: top = 0: X(top) = hx: Y(top) = hy 'initialize
Do
    _Title Str$(top + 1)
    Line (0, 0)-(xmax, ymax), &HFF006600, BF 'clear garden

    '>>>>>>>>>>>       SNAKE BRAIN    <<<<<<<<<<<<<<<
    If hx = 0 And hy = 19 Then
        hy = hy - 1
    ElseIf hx Mod 2 = 0 And hy <> 0 And hy <> 19 Then
        hy = hy - 1
    ElseIf hx Mod 2 = 0 And hy = 0 And hy <> 19 Then
        hx = hx + 1
    ElseIf hx Mod 2 = 1 And hx <> 19 And hy < 18 Then
        hy = hy + 1
    ElseIf hx Mod 2 = 1 And hx <> 19 And hy = 18 Then
        hx = hx + 1
    ElseIf hx = 19 And hy = 19 Then
        hx = hx - 1
    ElseIf hy = 19 And hx <> 0 Then
        hx = hx - 1
    ElseIf hx Mod 2 = 1 And hy = 0 And hy <> 19 Then
        hy = hy + 1
    ElseIf hx = 19 And hy < 19 Then
        hy = hy + 1
    End If
    For i = 0 To top - 1
        X(i) = X(i + 1): Y(i) = Y(i + 1)
    Next
    X(top) = hx: Y(top) = hy

    'apple
    If (ax = hx And ay = hy) Then 'snake eats apple, get new apple watch it's not where snake is
        top = top + 1
        X(top) = hx: Y(top) = hy
        Do 'check new apple
            ax = Int(Rnd * sqs): ay = Int(Rnd * sqs): good = -1
            For i = 0 To top - 1
                If ax = X(i) And ay = Y(i) Then good = 0: Exit For
            Next
        Loop Until good
    End If
    Line (ax * sq, ay * sq)-Step(sq - 2, sq - 2), _RGB32(255, 100, 255), BF

    'snake
    Erase overlap
    For i = 0 To top
        If i = top Then
            c~& = &HFF000000
        Else
            Select Case (top - i) Mod 4
                Case 0: c~& = &HFF000088
                Case 1: c~& = &HFF880000
                Case 2: c~& = &HFFBB8800
                Case 3: c~& = &HFF008888
            End Select
        End If
        overlap(X(i), Y(i)) = overlap(X(i), Y(i)) + 1
        Line (X(i) * sq, Y(i) * sq)-Step(sq - 2, sq - 2), c~&, BF
        If overlap(X(i), Y(i)) > 1 Then Line (X(i) * sq + .25 * sq, Y(i) * sq + .25 * sq)-Step(.5 * sq - 2, .5 * sq - 2), &HFFFFFFFF, BF
    Next
    _Display
    If top < 10 Then
        _Limit 10 + top
    ElseIf top < 300 Then
        _Limit 100
    Else
        _Limit 10
    End If
Loop

And it's the dumbest snake I have!


RE: Smarter than a fb Worm - bplus - 02-14-2023

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.

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



RE: Smarter than a fb Worm - TempodiBasic - 02-15-2023

Hi Bplus
I like very much your Snake AI demo!
Snake appears very smart in movement and catching food until its lenght stay under 30 blocks...
but I loose something, because some times it appears clearly a collision at the next step between head and body of snake, while in other situations it is very hard to see why does it return collision.


RE: Smarter than a fb Worm - bplus - 02-15-2023

(02-15-2023, 12:30 AM)TempodiBasic Wrote: Hi Bplus
I like very much your Snake AI demo!
Snake appears very smart in movement and catching food until its lenght stay under 30 blocks...
but I loose something, because some times it appears clearly a collision at the next step between head and body of snake, while in other situations it is very hard to see why does it return collision.

The reason for the crash is always in the title bar.  

When the head tries to do an 180, go in reverse, you don't see much difference in position. Just notice the fruit is on the opposite side of the snakes body as the head.


RE: Smarter than a fb Worm - bplus - 02-15-2023

Body/Self Awareness, if we coil the snake before it strikes out for food it won't go crashing into itself.
Code: (Select All)
Option _Explicit
_Title "Snake AI-1_8 Trailblazer" 'b+ 2020-03-23 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.

'2020-03-21 Snake AI-1_8 Trailblazer   a Smarter Snake!
' As described at forum today, entice snake to safely coil itself before going after fruit at
' each increase of it's length. Does't look like this will work out.
' 3-22 try Trailblazer square attack pattern, looks simpler can we connect to safe coil map?
' No connection yet: crash, crash, crash.... my brain is broken!
' 3-23 New idea for connnecting square frame pattern for fruit catching to the safe coil map.
' Looking good! 2-320's 2-360s and 2-perfect 399! Generalize variables for any even field and
' try for perfect 399 everytime. Analyzed the few crashes and fixed bodyStack and yHeadLimit
' so even more perfect runs! The bigger sqrsX is the more slack needs to be built into
' bodyStack.

DefInt A-Z '<< new change for this version 2020-03-23
' Snakepit Dimensions: square size = sq, sqrsX = # of squares along x-axis and sqrsY squares down.
Const sq = 20, sqrsX = 10, sqrsY = 30, 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 '                                                                  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, good, KEY$, r As Single, g As Single, b As Single
Dim autoPilot, hSpeed As Single, aSpeed As Single, saveChange As XY, title$

help '                                                                                    Key Menu
hSpeed = 3: aSpeed = 20 '                    autopilot speed is independent of human control speed

restart: '                                                                            reinitialize
r = .4 + Rnd * .6: g = r * .5 + Rnd * .4 - .2: b = .5 * r + Rnd * .4 - .2 '     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
        'snakeBrainBplus2 '    dumb track AI but looks cool! requirescustom sqrsX = 17, sqrsY = 16
        'snakeBrainAshish1 '     first "realAI" I would call an heuristic approach, thanks Ashish!
        'snakeBrainBplus3 '                 bplus "first real AI" uses modified Pathfinder methods

        snakeBrainBplus4 '                       Trailblazer dont find a path, make a path pattern
        '=========================================================================================

        '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
Beep '                                                                                 wake me up!
If sLen >= sqrsX * sqrsY - 1 Then _Delay 10 Else _Delay 4 '                 win or loose, go again
GoTo restart:

Sub screenUpdate ' draw snake and fruit, overlap code debugger
    Dim c~&, i, overlap(sqrsX, sqrsY)
    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"
    _PrintString (610, 232), "         or"
    _PrintString (610, 248), "the run has finished."

End Sub

'basic functions added for snakeBrainBplus3 (bplus first real AI)
Function max (n, m)
    If n > m Then max = n Else max = m
End Function

Function min (n, m)
    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 , m ),   FUNCTION min (n , m )

    'from: Pathfinder inside Maze.bas B+ 2019-12-19 only completely overhauled!
    Dim x, y, i, changeF
    Dim parentF, tick, foundHead, headMarked
    Dim yStart, yStop, xStart, xStop
    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
        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

Sub snakeBrainBplus4 '    Trailblazer dump Pathfinder and set a path pattern so no finding needed!
    Static xLim, yLim, dat$(sqrsX - 1, sqrsY - 1), trackON
    Dim x, y, bodyStack, yHeadLimit
    xLim = sqrsX - 1: yLim = sqrsY - 1
    If sLen < 2 Then trackON = 0 '                               in case of crash turn off trackON
    If dat$(0, 0) <> "D" Then GoSub setupdat '                               haven't been here yet

    bodyStack = Int(sLen / (2 * xLim)) '    these are rounded down so be careful to build in slack
    yHeadLimit = yLim - bodyStack * 2 + 1 '                  + 1 because bodystack is rounded down
    If head.X = 0 And head.Y = yHeadLimit Then trackON = -1
    If head.X = 0 And head.Y = yHeadLimit - 1 Then trackON = -1
    If head.X = 0 And head.Y = yHeadLimit - 2 Then trackON = -1
    If head.X = xLim And head.Y = yHeadLimit - 1 Then
        If sLen <= sqrsX * sqrsY - 2 * bodyStack Then trackON = 0
    End If
    If sLen > sqrsX * sqrsY - 2 * bodyStack Then trackON = -1 '  finish last 2 bodystacks in track
    If trackON Then '                                     take orders for safe coil stacking track
        Select Case dat$(head.X, head.Y)
            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
    Else '  this is the: left down, bottom right, right up, left to fruit and left down... pattern
        If head.X = 0 Then '                                                             left side
            If head.Y <> yLim Then
                change.X = 0: change.Y = 1
            Else
                change.X = 1: change.Y = 0
            End If
        ElseIf head.X >= 1 And head.X < xLim Then '     middle rows, left or right including edges
            If head.Y = yLim Then
                change.X = 1: change.Y = 0 '                                            bottom row
            Else
                change.X = -1: change.Y = 0 '                             row bearing fruit or top
            End If
        ElseIf head.X = xLim Then '                          right column going up to fruit height
            If head.Y = 0 Then
                change.X = -1: change.Y = 0 '                               here we must turn left
            ElseIf head.Y = fruit.Y And fruit.Y < yLim Then '  ah! fruit bearing row not at bottom
                change.X = -1: change.Y = 0
            Else
                change.X = 0: change.Y = -1 '                                        keep going up
            End If
        End If
    End If
    Exit Sub

    '    This sets up a track pattern to follow until the coils have been safely stacked enough to
    ' break away and catch fruit.
    setupdat:
    For y = 0 To yLim
        For x = 0 To xLim
            If x = 0 And y <> yLim Then '                    left side
                dat$(x, y) = "D"
            ElseIf x = 0 And y = yLim Then '                 bottom, left corner
                dat$(x, y) = "R"
            ElseIf x <> xLim And y = yLim Then '             bottom row
                dat$(x, y) = "R"
            ElseIf x = xLim And y Mod 2 = 1 Then '           right side up odd
                dat$(x, y) = "U"
            ElseIf x = xLim And y Mod 2 = 0 Then '           right side left even
                dat$(x, y) = "L"
            ElseIf y Mod 2 = 0 And x = 1 And y <> 0 Then '   left coil even turn up
                dat$(x, y) = "U"
            ElseIf y Mod 2 = 0 And x = 1 And y = 0 Then '    left coil even on top row
                dat$(x, y) = "L"
            ElseIf y Mod 2 = 1 And x <> 1 Then '             coil odd row
                dat$(x, y) = "R"
            ElseIf y Mod 2 = 1 And x = 1 And y <> yLim Then 'coil odd row
                dat$(x, y) = "R"
            ElseIf y Mod 2 = 0 And x <> 1 Then '             coil even
                dat$(x, y) = "L"
            ElseIf y Mod 2 = 0 And x = 1 Then '              coil even
                dat$(x, y) = "R"
            End If
        Next
    Next
    Return
End Sub

And so the snake never dies until the screen is full of it!