Print Page - Smart Snake

Title: Smart Snake
Post by: bplus on March 15, 2020, 01:39:16 pm

This snake drives on auto-pilot:

Code: QB64: [Select]

_TITLE "Snake AI-1" 'b+ 2020-03-14
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)
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
    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
        LINE (X(i) * sq, Y(i) * sq)-STEP(sq - 2, sq - 2), c~&, BF
    NEXT
    _DISPLAY
    _LIMIT 10
LOOP
 
 

It's smart because it will never crash into a wall, or itself and will (eventually) always get the fruit and grow to fill the garden BUT!
it's about the dumbest smart snake you could ask for.

Can anyone make it smarter? ie get to food faster without crashing into itself when it gets longer.

Oh also does anyone know why this runs to like 487 fruits eaten and not <= 400 that should fill garden with snake segments?

PS I mean theoretically this program should hang when there is no longer a place to put the fruit because the snake has filled the garden 400 squares by my calculations, so how is it going past that point before hanging?

Title: Re: Smart Snake
Post by: bplus on March 15, 2020, 03:09:16 pm

Here is what I mean: at the end, it finally hangs at, in this case 473 fruits consumed.

Cool optical illusion too!

[ This attachment cannot be displayed inline in 'Print Page' view ]

Title: Re: Smart Snake
Post by: bplus on March 17, 2020, 01:01:29 am

The mystery of the extra boxes is solved:

Code: QB64: [Select]

_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!
' Found! :  White box in square is duplicate segment created
' as eat fruit and deleted when reaches tail end.
 
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 < 300 THEN _LIMIT 400 ELSE _LIMIT 20
LOOP
 
 

[ This attachment cannot be displayed inline in 'Print Page' view ]

Fascinating!

Title: Re: Smart Snake
Post by: bplus on March 17, 2020, 01:36:10 am

Fixed :

Code: QB64: [Select]

_TITLE "Snake AI-1_2" 'b+ 2020-03-17
'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 occasional flashing duplicate box
 
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
    lastx = X(0): last(Y) = Y(0)
    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
        FOR i = top TO 1 STEP -1
            X(i) = X(i - 1): Y(i) = Y(i - 1)
        NEXT
        X(0) = lastx: Y(0) = lasty
        '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
                IF ax = X(i) AND ay = Y(i) THEN good = 0: EXIT FOR
            NEXT
            IF ax = lastx AND ay = lasty THEN good = 0
        LOOP UNTIL good
    END IF
 
    '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
    LINE (ax * sq, ay * sq)-STEP(sq - 2, sq - 2), _RGB32(255, 100, 255), BF
    _DISPLAY
    IF top < 330 THEN _LIMIT 400 ELSE _LIMIT 20
LOOP
 
 

[ This attachment cannot be displayed inline in 'Print Page' view ]

Fixed except we have a new mystery, the occasional flashing duplicate box?

Title: Re: Smart Snake
Post by: bplus on March 17, 2020, 10:07:02 pm

Reworked code and fixed all signs of duplicate segments, you can now toggle between human pilot and AI called Snake Brain, can also toggle pauses and speed or slow snake independently for human and AI. Now ready to plug-in different brains for snake, oh designer coloring too.

Code: QB64: [Select]

OPTION _EXPLICIT
_TITLE "Snake AI-1_3 wRules" 'b+ 2020-03-17
'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.
 
'snakepit constraints   Snake Brain currently needs sqrsX to be even
CONST sq = 20, sqrsX = 20, sqrsY = 20, xmax = sq * sqrsX, ymax = sq * sqrsY
SCREEN _NEWIMAGE(800, 600, 32)
_DELAY .25
_SCREENMOVE _MIDDLE
RANDOMIZE TIMER
 
'teach UDV
TYPE XY
    X AS INTEGER
    Y AS INTEGER
END TYPE
 
'shared for screenUpdate
DIM SHARED fruit AS XY, snake(1 TO sqrsX * sqrsY) AS XY, sLen AS INTEGER '< sLen = length of snake
DIM SHARED overlap(sqrsX, sqrsY) AS INTEGER, pal(sqrsX * sqrsY) AS _UNSIGNED LONG, head AS XY
'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, dx AS INTEGER, dy AS INTEGER, hSpeed, aSpeed
 
help
hSpeed = 3: aSpeed = 20
restart: 'reinitialize
r = .3 + RND * .7: g = r * .5 + RND * .3 - .15: b = .5 * r + RND * .3 - .15
FOR i = 1 TO sqrsX * sqrsY
    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 - 2: head.Y = sqrsY / 2 - 2
fruit.X = sqrsX / 2 + 2: fruit.Y = sqrsY / 2 + 2
sLen = 1
snake(sLen).X = head.X: snake(sLen).Y = head.Y
autoPilot = 1
dx = 0: dy = 1
DO
    _TITLE STR$(sLen)
    LINE (0, 0)-(xmax, ymax), &HFF884422, BF 'clear snakepit
    IF sLen = sqrsX * sqrsY - 1 THEN screenUpdate: EXIT DO
    key$ = INKEY$
    IF key$ = "q" OR key$ = CHR$(27) THEN '                                           here is quit
        END '
    ELSEIF key$ = "a" THEN '                                                      toggle autoPilot
        autoPilot = 1 - autoPilot
        IF autoPilot = 0 THEN 'try to handover to human without immdeiate body crash
            dx = 0: IF head.X MOD 2 THEN dy = 1 ELSE dy = -1
        END IF
    ELSEIF key$ = "p" THEN '                                                                 pause
        _KEYCLEAR
        WHILE INKEY$ <> "p": _LIMIT 60: WEND
    ELSEIF key$ = "s" THEN
        IF autoPilot AND aSpeed + 5 < 400 THEN aSpeed = aSpeed + 5
        IF autoPilot = 0 AND hSpeed + .5 < 10 THEN hSpeed = hSpeed + .5
    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?
 
        ' PLUG-IN YOUR Snake Brain AI here
        '===========================================================================  AI Auto Pilot
        snakeBrain
        '=========================================================================================
 
    ELSE ' '=======================================================================  human control
        IF key$ = CHR$(0) + CHR$(72) THEN '                                               up arrow
            dx = 0: dy = -1
        ELSEIF key$ = CHR$(0) + CHR$(80) THEN '                                         down arrow
            dx = 0: dy = 1
        ELSEIF key$ = CHR$(0) + CHR$(77) THEN '                                        right arrow
            dx = 1: dy = 0
        ELSEIF key$ = CHR$(0) + CHR$(75) THEN '                                         left arrow
            dx = -1: dy = 0
        END IF
        head.X = head.X + dx: head.Y = head.Y + dy
    END IF
 
    '                                                                  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
    END IF
 
    ' 2. Snake eats body part, dies. This should kill snake if turn its head back on itself.
    FOR i = 1 TO sLen 'start 1 up from tail segment about to be dropped
        IF head.X = snake(i).X AND head.Y = snake(i).Y THEN
            _TITLE _TRIM$(STR$(sLen)) + " Body Crash": screenUpdate: EXIT DO
        END IF
    NEXT
 
    ' 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 apple
        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
            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
    END IF
 
    screenUpdate
 
    IF autoPilot THEN
        'IF sLen < 80 THEN _LIMIT 40 ELSE _LIMIT 10
        _LIMIT aSpeed
    ELSE
        _LIMIT hSpeed
    END IF
LOOP
 
_DELAY 3
GOTO restart:
 
SUB screenUpdate ' draw snake and fruit, overlap code debugger
    DIM c~&, i AS INTEGER
 
    ERASE overlap
    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
            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 snakeBrain '>>>>>>>>>>   B+  SNAKE BRAIN  needs sqrsX to be even number  <<<<<<<<<<<<<<<
    IF head.X = 0 AND head.Y = sqrsY - 1 THEN
        head.Y = head.Y - 1
    ELSEIF head.X MOD 2 = 0 AND head.Y <> 0 AND head.Y <> sqrsY - 1 THEN
        head.Y = head.Y - 1
    ELSEIF head.X MOD 2 = 0 AND head.Y = 0 AND head.Y <> sqrsY - 1 THEN
        head.X = head.X + 1
    ELSEIF head.X MOD 2 = 1 AND head.X <> sqrsX - 1 AND head.Y = sqrsY - 2 THEN
        head.X = head.X + 1
    ELSEIF head.X MOD 2 = 1 AND head.X <> sqrsX - 1 AND head.Y < sqrsY - 1 THEN
        head.Y = head.Y + 1
    ELSEIF head.X = sqrsX - 1 AND head.Y = sqrsY - 1 THEN
        head.X = head.X - 1
    ELSEIF head.Y = sqrsY - 1 AND head.X <> 0 THEN
        head.X = head.X - 1
    ELSEIF head.X MOD 2 = 1 AND head.Y = 0 AND head.Y <> sqrsY - 1 THEN
        head.Y = head.Y + 1
    ELSEIF head.X = sqrsX - 1 AND head.Y < sqrsY - 1 THEN
        head.Y = head.Y + 1
    END IF
END SUB
 
SUB help
    _PRINTSTRING (600, 20), "Keys:"
    _PRINTSTRING (600, 40), "p toggles pause on/off"
    _PRINTSTRING (600, 60), "a toggles autoPilot"
    _PRINTSTRING (600, 100), "arrows control snake"
    _PRINTSTRING (600, 80), "q or esc quits"
    _PRINTSTRING (600, 120), "s increases speed"
    _PRINTSTRING (600, 140), "- decreases speed"
END SUB
 

Title: Re: Smart Snake
Post by: Ashish on March 18, 2020, 02:05:57 am

Good work, bplus. I personally like the new color of snake. Color of the snake in previous post was irritating to me (IDK why :) ).

Title: Re: Smart Snake
Post by: bplus on March 18, 2020, 11:37:43 am

Thanks Ashish, yeah snake coloring more natural I think.

You know I was hoping to get a little challenge going, Who can build the best snake AI or driver to plug into the game?

Now I wonder if anyone (including myself) can build a driver that can load up on fruit faster and fill the board in fewer steps on average. Because the fruit is placed randomly there will be better and worse runs but all need to get all the fruit eaten without crashing into wall (simple with AI that knows borders) or crashing the snake into it's own body including turning the head 180 degrees back onto it's body. This gets harder as snake gets longer. For humans the hardest part is not turning snake back on itself, IMHO, but for AI getting the fruit without running into another part of the body afterwards is where brains are needed.

So the object is to fill the board with snake until all but one board cell is snake (that starts new game).

Your Snake AI is allowed to know these things:
1. The Boundaries of the snake pit (I no longer call it a garden).
for x between 0 and sqrsX-1, for y between 0 and sqrsY - 1
BTW sqrsX is cells across and sqrsY is cells down.
2. Where the fruit is, fruit(x, y)
3. The listing of it's length and body segments, snake(i).(x, y), snake length = sLen
4. Track it's direction, I call dx and dy, the change on the x-axis = dx and the change on y-axis = dy.
These are always just -1, 0, 1 and if ABS(dx) = 1 then dy = 0 and vice versa.
?hmm... use STATIC your own dx, dy in the SnakeBrain SUB (my demo is going strictly by board locations at
present).
5. Oh! Most important of all, know where it's head is at! head(x, y)
Snake input is all above as SHARED and AI output just says where the head goes next by altering that value in the AI.

Now I realize my tester has to handle the case when both head x, y are 0 (a full stop) or both have a value other than 0 (s.t. the head starts heading diagonally).

My goal here was to create an AI tester, not so much a game with a pretty snake that's just icing ;-))

Update: here is the checks on the head change after the AI changes it in the Snake Brain plug-in code. The code will reset head(x, y) back if there is a problem with the head(x, y) returned from snake brain.

Code: QB64: [Select]

OPTION _EXPLICIT
_TITLE "Snake AI-1_4 fix tester" 'b+ 2020-03-18
'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.
 
'snakepit constraints   Snake Brain currently needs sqrsX to be even
CONST sq = 20, sqrsX = 20, sqrsY = 20, xmax = sq * sqrsX, ymax = sq * sqrsY
SCREEN _NEWIMAGE(800, 600, 32)
_DELAY .25
_SCREENMOVE _MIDDLE
RANDOMIZE TIMER
 
'teach UDV
TYPE XY
    X AS INTEGER
    Y AS INTEGER
END TYPE
 
'shared for screenUpdate
DIM SHARED fruit AS XY, snake(1 TO sqrsX * sqrsY) AS XY, sLen AS INTEGER '< sLen = length of snake
DIM SHARED overlap(sqrsX, sqrsY) AS INTEGER, pal(sqrsX * sqrsY) AS _UNSIGNED LONG, head AS XY
'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, dx AS INTEGER, dy AS INTEGER, hSpeed, aSpeed
DIM saveHead AS XY
 
help
hSpeed = 3: aSpeed = 20
 
restart: 'reinitialize
r = .3 + RND * .7: g = r * .5 + RND * .3 - .15: b = .5 * r + RND * .3 - .15
FOR i = 1 TO sqrsX * sqrsY
    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 - 2: head.Y = sqrsY / 2 - 2
fruit.X = sqrsX / 2 + 2: fruit.Y = sqrsY / 2 + 2
sLen = 1
snake(sLen).X = head.X: snake(sLen).Y = head.Y
autoPilot = 1
dx = 0: dy = 1
DO
    _TITLE STR$(sLen)
    LINE (0, 0)-(xmax, ymax), &HFF884422, BF 'clear snakepit
    IF sLen = sqrsX * sqrsY - 1 THEN screenUpdate: EXIT DO
    KEY$ = INKEY$
    IF KEY$ = "q" OR KEY$ = CHR$(27) THEN '                                           here is quit
        END '
    ELSEIF KEY$ = "a" THEN '                                                      toggle autoPilot
        autoPilot = 1 - autoPilot
        IF autoPilot = 0 THEN 'try to handover to human without immdeiate body crash
            dx = 0: IF head.X MOD 2 THEN dy = 1 ELSE dy = -1
        END IF
    ELSEIF KEY$ = "p" THEN '                                                                 pause
        _KEYCLEAR
        WHILE INKEY$ <> "p": _LIMIT 60: WEND
    ELSEIF KEY$ = "s" THEN
        IF autoPilot AND aSpeed + 5 < 400 THEN aSpeed = aSpeed + 5
        IF autoPilot = 0 AND hSpeed + .5 < 10 THEN hSpeed = hSpeed + .5
    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?
 
        saveHead.X = head.X: saveHead.Y = head.Y
        tryAgain:
        head.X = saveHead.X: head.Y = saveHead.Y
        ' PLUG-IN YOUR Snake Brain AI here
        '===========================================================================  AI Auto Pilot
        snakeBrain
        '=========================================================================================
 
        'check changes to head (x, y)
        IF ABS(saveHead.X - head.X) = 0 THEN 'must have diffence in y's
            IF ABS(saveHead.Y - head.Y) <> 1 THEN GOTO tryAgain
        ELSEIF ABS(saveHead.Y - head.Y) = 0 THEN
            IF ABS(saveHead.X - head.X) <> 1 THEN GOTO tryAgain
        ELSE ' must have a difference of 0 in either x or y but not both
            GOTO tryAgain
        END IF
 
    ELSE ' '=======================================================================  human control
        IF KEY$ = CHR$(0) + CHR$(72) THEN '                                               up arrow
            dx = 0: dy = -1
        ELSEIF KEY$ = CHR$(0) + CHR$(80) THEN '                                         down arrow
            dx = 0: dy = 1
        ELSEIF KEY$ = CHR$(0) + CHR$(77) THEN '                                        right arrow
            dx = 1: dy = 0
        ELSEIF KEY$ = CHR$(0) + CHR$(75) THEN '                                         left arrow
            dx = -1: dy = 0
        END IF
        head.X = head.X + dx: head.Y = head.Y + dy
    END IF
 
    '                                                                  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
    END IF
 
    ' 2. Snake eats body part, dies. This should kill snake if turn its head back on itself.
    FOR i = 1 TO sLen 'start 1 up from tail segment about to be dropped
        IF head.X = snake(i).X AND head.Y = snake(i).Y THEN
            _TITLE _TRIM$(STR$(sLen)) + " Body Crash": screenUpdate: EXIT DO
        END IF
    NEXT
 
    ' 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 apple
        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
            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
    END IF
 
    screenUpdate
 
    IF autoPilot THEN
        'IF sLen < 80 THEN _LIMIT 40 ELSE _LIMIT 10
        _LIMIT aSpeed
    ELSE
        _LIMIT hSpeed
    END IF
LOOP
 
_DELAY 3
GOTO restart:
 
SUB screenUpdate ' draw snake and fruit, overlap code debugger
    DIM c~&, i AS INTEGER
 
    ERASE overlap
    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
            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 snakeBrain '>>>>>>>>>>   B+  SNAKE BRAIN  needs sqrsX to be even number  <<<<<<<<<<<<<<<
    IF head.X = 0 AND head.Y = sqrsY - 1 THEN
        head.Y = head.Y - 1
    ELSEIF head.X MOD 2 = 0 AND head.Y <> 0 AND head.Y <> sqrsY - 1 THEN
        head.Y = head.Y - 1
    ELSEIF head.X MOD 2 = 0 AND head.Y = 0 AND head.Y <> sqrsY - 1 THEN
        head.X = head.X + 1
    ELSEIF head.X MOD 2 = 1 AND head.X <> sqrsX - 1 AND head.Y = sqrsY - 2 THEN
        head.X = head.X + 1
    ELSEIF head.X MOD 2 = 1 AND head.X <> sqrsX - 1 AND head.Y < sqrsY - 1 THEN
        head.Y = head.Y + 1
    ELSEIF head.X = sqrsX - 1 AND head.Y = sqrsY - 1 THEN
        head.X = head.X - 1
    ELSEIF head.Y = sqrsY - 1 AND head.X <> 0 THEN
        head.X = head.X - 1
    ELSEIF head.X MOD 2 = 1 AND head.Y = 0 AND head.Y <> sqrsY - 1 THEN
        head.Y = head.Y + 1
    ELSEIF head.X = sqrsX - 1 AND head.Y < sqrsY - 1 THEN
        head.Y = head.Y + 1
    END IF
END SUB
 
SUB help
    _PRINTSTRING (600, 20), "Keys:"
    _PRINTSTRING (600, 40), "p toggles pause on/off"
    _PRINTSTRING (600, 60), "a toggles autoPilot"
    _PRINTSTRING (600, 100), "arrows control snake"
    _PRINTSTRING (600, 80), "q or esc quits"
    _PRINTSTRING (600, 120), "s increases speed"
    _PRINTSTRING (600, 140), "- decreases speed"
END SUB
 
 

Update: the more I think about it, the more the Snake Brain needs access to or shared dx and dy. So I have to change the tester again to save those too before call to SnakeBrain plug-in driver... after lunch and errands, I will update again, sorry.

Update 2 (1 hour later): and the more I think about it the AI is likely to return the same change to head over and over and we get stuck in a loop so we might have to end with error message.

Title: Re: Smart Snake
Post by: bplus on March 18, 2020, 11:27:19 pm

Got it! If there is an error in AI the control of snake is turned over to human with a beep to signal the switch.

I switched dx, dy to change AS XY (type) and now like the human control, the AI only changes the change.X, change.Y values, then the code takes over to update the head and check the rules for crashes, eats or just plain moves.

I had to rewrite the SnakeBrain SUB with these changes and cause an immediate exit if sqrsX (number of square on x-axis) is odd because at present it depends on an even amount of columns. It throws an error and made for excellent way to check the change checker part of the code. Did some more formal commenting of all the code and maybe now it is should be ready to try some brain transplants.

Code: QB64: [Select]

OPTION _EXPLICIT
_TITLE "Snake AI-1_5 SHARE change AS XY" 'b+ 2020-03-18
'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.
 
'  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
 
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
    _TITLE STR$(sLen)
    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
        snakeBrain
        '=========================================================================================
 
        '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
    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!
        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 3 '                                                                   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 snakeBrain '>>>>>>>>>>   B+  SNAKE BRAIN  needs sqrsX to be even number  <<<<<<<<<<<<<<<
 
    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 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
 
 

Too bad I can't have 2 best Answers but the information provided in reply above is going to start a manual.

Title: Re: Smart Snake
Post by: Ashish on March 19, 2020, 12:30:21 pm

@bplus
I attepmt to create my AI for the snake. Well, it does not fill the whole tile for now but it does grow faster than yours.
The best score which I saw it making was 49 on my system. I know it can do even better if I give more time to it.
The code of AI is crazy. It is fun to see how it makes its decision. Sometime, it just get stuck in an infinite loop and snake start
to follow a circular path.

Code: QB64: [Select]

'Ashish MOD
'Sorry bplus, but modified your a code a little. ;)
OPTION _EXPLICIT
 
$CONSOLE
'debuging, if there is AI error, then prints the change value along with state of AI SUB
DIM SHARED state$ 'for debuging
 
_TITLE "Snake AI-1_5 SHARE change AS XY" 'b+ 2020-03-18
'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.
 
'################ MOD by Ashish ######################
'Added my own AI. It took 3 hours xD
 
'  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
 
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
    _TITLE STR$(sLen)
    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
        snakeBrain
        '=========================================================================================
 
        '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
        'DEBUG
        IF autoPilot = 0 THEN
            _ECHO STR$(change.X) + "," + STR$(change.Y)
            _ECHO state$
            SLEEP
        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
    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!
        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 3 '                                                                   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 snakeBrain '>>>>>>>>>>   B+  SNAKE BRAIN  needs sqrsX to be even number  <<<<<<<<<<<<<<<
 
    '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
    DIM nx, ny, dx, dy 'Ashish AI
    STATIC decided
    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 IF
END SUB
 
FUNCTION snakeBodyExists (which%)
    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 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
 
 

EDIT : The code is updated, just fixed a minor bug.

Title: Re: Smart Snake
Post by: bplus on March 19, 2020, 01:00:38 pm

@Ashish this is great, you got the idea of only changing change.X and change.Y in snake brain SUB and yes allowed to make supplemental functions and subs to help make decisions on change. Everything is good as long as you don't mess with any other of the snake game variables of main program.

I see your AI getting stuck in loop going around and around 1 cell above fruit location, I switched to manual grabbed the fruit and then switched back to autoPilot and your code picked right up again, great start!

I am thinking we might need a status report on who / what is current driver, human or AI

Oh! if you keep your SnakeBrain code separate and list the supplemental procedures it uses, we can store other peoples versions of snake brain and maybe evolve better and better AI. ie SnakeBrainByAshish, SnakeBrainByBplus,...

Title: Re: Smart Snake
Post by: bplus on March 19, 2020, 06:35:16 pm

Quote from: [banned user] on March 19, 2020, 01:48:42 pm

NOW we have a "SMART" Snake. Is this a Serpentine from one of the five tribes? Great job! This is addicting to watch but crashes all the time, especially when speed increases.
Moving the window also crashes the program.

All these crashes??? Are you using code from Best Answer? Are you toggling key "a" so human has to drive snake?

How can moving window possibly crash snake??? unless you are driving snake and paying attention to dragging window instead of driving. There is "p" for pause that can stop action so you can move the already centered window to where ever you like. Also the "-" key will slow down AI speed or human speed depending what mode you are in.

Wait... are you using this on DOS ;-))

Title: Re: Smart Snake
Post by: bplus on March 19, 2020, 09:56:41 pm

Hi [banned user],

Thanks for feedback, I don't have Linux let alone Debian version so I have no idea the troubles you guys have.

Title: Re: Smart Snake
Post by: bplus on March 19, 2020, 10:46:32 pm

Here is another snake who always gets it's fruit! Not the least bit faster than snakeBrainBplus1 but fancier!
Just leave in autoPilot and watch the show :)

Code: QB64: [Select]

OPTION _EXPLICIT
_TITLE "Snake AI-1_6 B+brain#2" 'b+ 2020-03-19
'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 snakeBrain 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.
 
 
'  Snakepit Dimensions: square size = sq, sqrsX = # of squares along x-axis and sqrsY squares down.
CONST sq = 20, sqrsX = 17, sqrsY = 16, 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
 
DIM SHARED brain2Directions(0 TO sqrsX - 1, 0 TO sqrsY - 1) AS STRING '     for snakeBrainBplus2 AI
 
'   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
 
 
loadBrain2Directions '                    load array with directions for each cell for AI to follow
 
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
        snakeBrainBplus2 ' note: snakeBrainBplus1 won't work for this custom sqrsX, sqrsY version.
        '=========================================================================================
 
        '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
    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!
        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 ' ndependent speed control for human and AI
LOOP
_DELAY 3 '                                                                  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 snakeBrainBplus1 '>>>>>>>>>>   B+  SNAKE BRAIN  needs sqrsX to be even number  <<<<<<<<<<<<<<<
 
    '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 and SUB loadBrain2Directions
    DIM direction$
    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
END SUB
 
SUB loadBrain2Directions ' for custom snakeBrainBplus2
    DIM x, y, s$
    FOR y = 0 TO sqrsY - 1
        READ s$
        FOR x = 0 TO sqrsX - 1
            brain2Directions(x, y) = MID$(s$, x + 1, 1)
        NEXT
    NEXT
    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
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
 
 

[ This attachment cannot be displayed inline in 'Print Page' view ]

Title: Re: Smart Snake
Post by: Ashish on March 20, 2020, 04:59:10 am

@[banned user]
The program do not crash on my machine.

@bplus Its nice. Another Good approach.
I tried to improve my AI to take better decision by tracking the location of fruit and its body units but the result is worse. Only thing good is that It now never stuck in a loop but it do "body crash". I think I must not post the code. It has now become full of IF...THEN clause. And guess what, now I, myself not able to understand what I wrote (xD).

Title: Re: Smart Snake
Post by: TempodiBasic on March 20, 2020, 07:39:25 am

Hi guys
in windows 10 it runs well

in Lubuntu 14 06 on Oracle VirtualBox it runs just few seconds and then it crashes!
I'm thinking that there is a substantial difference between Windows and Linux version of QB64.

Please can someone test this code on Mac so we get a whole overview on the 3 platform of QB64 performances.

Title: Re: Smart Snake
Post by: bplus on March 20, 2020, 09:58:19 am

Quote

I tried to improve my AI to take better decision by tracking the location of fruit and its body units but the result is worse. Only thing good is that It now never stuck in a loop but it do "body crash". I think I must not post the code. It has now become full of IF...THEN clause. And guess what, now I, myself not able to understand what I wrote (xD).

@Ashish

A note of encouragement, your approach is what I would call "real AI" responding to real time information. Mine I would call dumb AI, I just put the snake on a track that is guaranteed to cover the board in a circuit before starting the loop over again. Your "real AI" has to eventually do that too, my AI has to loosen up at the beginning to gather fruit quicker. But keep in mind "the track" or one generated by AI for particular board scenario is the only way to get the whole board covered. You might say we are approaching the problem from different ends of the solution.

A good way to learn chess is to practice end games, that is sort of what my approach here is.

Title: Re: Smart Snake
Post by: TempodiBasic on March 20, 2020, 12:39:25 pm

Quote

A good way to learn chess is to practice end games, that is sort of what my approach here is.

In my experience it is the best way
after elementary final and theoretichal draw the chesser goes on with middle game ideas and schemes and going on to the first elementary opening study.

In the same manner how you can learn from the code of a masterpiece program if you have no idea of the elementary tecniques used to manage some issue...so you can see online a Fisher Spassky game and with all the comments it is very hard to understand their moves....in chess understand equals to can manage the situation and catch the advantage if the other side do a move that is not the best for him.

Chess is not difficult, it's consuming only time and coffee
;-)

Title: Re: Smart Snake
Post by: bplus on March 21, 2020, 10:58:03 am

Hi Ashish,

I got some "real AI" working so I reran your AI to compare. Man! it seems 100% improved since last I ran it! I think I missed testing after your edit, I thought I did. Often at snake length 41 it gets stuck in square loop track, most curious because the fruit is still accessible and snake head isn't trapped inside it's own body with no exit. That is what is killing my snake, at present one of these conditions is hanging the program for me and I can't get the snake to die a proper death yet so the program can move on. As soon as I get that fixed I will post but in meantime for your AI, I see it snap out of what might be an infinite loop situation before length 41 looks like you use RND when you hit some condition that you need to use when hit edge (I am guessing) maybe when hit edge RND choose to go up or down or left or right depending on edge. That might snap snake out of infinite loop, ha it might go into another one somewhere else and then go back to first one so you have infinite figure 8 like your avatar!

Also for future, I have idea of fake fruit, goal setting for snake to accomplish some unwinding before going for next real fruit. It's like parents saying you can't have desert until you finish your veggies. You can't have snake going for real fruit until it has safely coiled itself a bit before heading out. It's like steering a horse by dangling a carrot in front of it's eyes so it's not distracted by the grass at the side of the road. It should employ some STATIC variables, I have not needed yet.

Title: Re: Smart Snake
Post by: bplus on March 21, 2020, 01:07:06 pm

OK now we have 2 state of the art "real AI" Smart Snakes. I've incorporated Ashish SUB into b+ official version for Best Answer.

RE: snakeBrainAshish1
@Ashish I removed the $CONSOLE command and reassigned state$ as STATIC variable in your snakeBrain SUB, trying to keep these SUBs as self contained as possible so we can try to include everyone's submissions that add to evolution of Smart Snake. A couple of tiny edits but if you find anything really off let me know. Your supplemental FUNCTION comes right after your snakeBrain SUB because it is exclusive (at moment for your SUB). I have added 2 supplemental FUNCTIONs min and max but included under general program running code because these are so generic.

Re: snakeBrainBplus3
I started a heuristic approach a bit like Ashish yesterday when I realized, "Hey! I've worked on this problem before, this is Pathfinder work!" So all yesterday I modified a pathfinder app I used in maze running. Ran into really major walls. One was that maze runner allowed diagonal steps, not classic Snake Game and two it took me way, way too long to realized that INSTR("XYZ", var$ ( = "") ) was always going to always return True! For hours I am going nutz, "Why isn't this working?!?!?" and unraveling and jiggling this and that until I had hell of a mess. Simply Blunderful!
Anyway I finally realized the problem and then found some better methods to use with...

OH! a third big snag using Pathfinder method, you have to run through a complete map before changing anything on the map otherwise, again, things just won't work as "they should".

OK, anyway I got the thing working very well, it will hang up when it can no longer access the fruit. I have fixed most of the hanging with a programmed body crash (better than starving to death in hang and running CPU for nothing) but there is still an occasional hang that I've not tracked down, so don't leave this running unattended like a screen saver. Ashish code too will run infinite loops, so again not a screen saver, but we'll get there. :)

Oh to test the different snakeBrain codes just comment the one currently not commented and remove quote to one you want to try, snakeBrainBplus2 needs special sqrsX and sqrsY for running a cool snake pattern on a track.

Code: QB64: [Select]

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
        '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
        '=========================================================================================
 
        '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
 

Title: Re: Smart Snake
Post by: bplus on March 22, 2020, 10:33:05 am

Update on fake fruit:

Well it sort of worked and mostly was disaster. Turns out you can't put fake fruit on top of snake, yeah now I see it! and it looks like I need a pattern of approaching the fruit so the snake is out of it's way when setting up to approach next fruit.

I may have to scrap Pathfinder and work on Trailblazer!

Title: Re: Smart Snake
Post by: Ashish on March 22, 2020, 10:55:13 am

@bplus
Impressive! I like it a lot! Your "real AI" is of course better than mine in performance. It scored 63 on my system. The highest which my AI scored is
49.

Title: Re: Smart Snake
Post by: Ashish on March 23, 2020, 09:14:03 am

Hi everyone! I thought for creating another AI with totally different approach. This AI learn by its mistake(s)/experience(s). Somewhat
similar to one that are used in Deep Learning or Machine Learning models (as I imagine).
In the console window, it prints total experiences it had and the best performance (or score) done by it.
By total experiences, I mean for how many possible situation it had made its decision in its memory (snakeMemory array).
Theoritcaly, there can be maximum of 256 possible situation but in the program I get as high as 30-35.
and the best score which it made on my system so far is 13. It will get better as it get more experience.

Of course, my learning model is very badly made. A better learning model can be made.
@bplus, I modified your code a bit so that things can be done faster.
Here's the code -

Code: QB64: [Select]

$CONSOLE
OPTION _EXPLICIT
 
_TITLE "Snake AI-1_5 SHARE change AS XY" 'b+ 2020-03-18
'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.
 
'################ MOD by Ashish ######################
'Added my own AI. It took 3 hours xD
 
'  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
 
'##### snake brain related variables ######
TYPE snake_memory_type
    sn_l AS _BYTE
    sn_r AS _BYTE
    sn_t AS _BYTE
    sn_b AS _BYTE
 
    fr_l AS _BYTE
    fr_r AS _BYTE
    fr_t AS _BYTE
    fr_b AS _BYTE
 
    'j_l AS _BYTE
    'j_r AS _BYTE
    'j_t AS _BYTE
    'j_b AS _BYTE
    hx AS INTEGER
    hy AS INTEGER
 
 
    decision AS _BYTE
END TYPE
 
REDIM SHARED snakeMemory(1) AS snake_memory_type
DIM takeDecision AS LONG
'######################################################
 
' 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
 
help '                                                                                     Key Menu
hSpeed = 3: aSpeed = 20 '                     autopilot speed is independent of human control speed
aSpeed = 80 'so that it will learn faster
 
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
    _TITLE STR$(sLen)
    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
        takeDecision = snakeBrain
        '=========================================================================================
 
        '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
        '####################### Ashish AI related code #################################
        'if there is an error, it will try to change its decision for later events
        IF autoPilot = 0 THEN
            IF snakeMemory(takeDecision).decision < 5 THEN snakeMemory(takeDecision).decision = snakeMemory(takeDecision).decision + 1 ELSE snakeMemory(takeDecision).decision = 0
            _ECHO "new decision : " + STR$(snakeMemory(takeDecision).decision)
        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
        addExperience change
    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
        '#################################### Ashish AI related code #####################################
        IF snakeMemory(takeDecision).decision < 5 THEN snakeMemory(takeDecision).decision = snakeMemory(takeDecision).decision + 1 ELSE snakeMemory(takeDecision).decision = 0
        _ECHO "new decision : " + STR$(snakeMemory(takeDecision).decision)
        '##################################################################################################
        EXIT DO
    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
            '####################### Ashish AI related code ####################################################
            'if there is an error, it will try to change its decision for later events
            IF snakeMemory(takeDecision).decision < 5 THEN snakeMemory(takeDecision).decision = snakeMemory(takeDecision).decision + 1 ELSE snakeMemory(takeDecision).decision = 0
            '####################################################################################################
            EXIT DO '                 yes!
        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 3 '                                                                   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
 
FUNCTION snakeBrain '>>>>>>>>>>   B+  SNAKE BRAIN  needs sqrsX to be even number  <<<<<<<<<<<<<<<
 
    '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
 
    'Ashish AI 2, learn by its mistake.
    DIM f_left, f_right, f_top, f_bottom
    DIM sn_left, sn_right, sn_top, sn_bottom
    ' DIM j_left, j_right, j_top, j_bottom
    DIM decision, i AS LONG, n AS LONG, eventExists '0=not decided, 1=left, 2=right, 3=top, 4=bottom
    STATIC preSLen, bestSLen, bioClock AS _UNSIGNED _INTEGER64
 
    IF preSLen = sLen THEN bioClock = bioClock + 1
 
 
 
    IF bestSLen < sLen THEN bestSLen = sLen
 
    IF fruit.X - head.X > 0 THEN f_right = 1 ELSE f_left = 1
    IF fruit.Y - head.Y > 0 THEN f_bottom = 1 ELSE f_top = 1
 
    'IF fruit.X - head.X = -1 THEN j_left = 1
    'IF fruit.X - head.X = 1 THEN j_right = 1
    'IF fruit.Y - head.Y = -1 THEN j_top = 1
    'IF fruit.Y - head.Y = 1 THEN j_bottom = 1
 
    sn_left = snakeBodyExists(1, -1)
    sn_right = snakeBodyExists(1, 1)
    sn_top = snakeBodyExists(2, -1)
    sn_bottom = snakeBodyExists(2, 1)
 
    _ECHO "Total experiences(s) : " + STR$(UBOUND(snakeMemory) - 1) + ", Max Snake Length : " + STR$(bestSLen)
    FOR i = 0 TO UBOUND(snakeMemory) - 1
        'check if the current experiece exists in snake memory, so it can use that decision now.
        if snakeMemory(i).sn_l = sn_left and snakeMemory(i).sn_r = sn_right and _
        snakeMemory(i).sn_t = sn_top and snakeMemory(i).sn_b = sn_bottom and _
        snakeMemory(i).fr_l = f_left and snakeMemory(i).fr_r = f_right and _
        snakeMemory(i).fr_t = f_top and snakeMemory(i).fr_b = f_bottom  then
            IF bioClock > 50 THEN
                IF snakeMemory(i).decision < 5 THEN snakeMemory(i).decision = snakeMemory(i).decision + 1 ELSE snakeMemory(i).decision = 0
                bioClock = 0
            ELSE
                decision = snakeMemory(i).decision
            END IF
            snakeBrain = i
            eventExists = 1
        END IF
    NEXT
    IF eventExists = 0 THEN
        'add new experiece to snake brain
        n = UBOUND(snakeMemory)
 
        snakeMemory(n).sn_l = sn_left
        snakeMemory(n).sn_r = sn_right
        snakeMemory(n).sn_t = sn_top
        snakeMemory(n).sn_b = sn_bottom
 
        snakeMemory(n).fr_l = f_left
        snakeMemory(n).fr_r = f_right
        snakeMemory(n).fr_t = f_top
        snakeMemory(n).fr_b = f_bottom
 
        'snakeMemory(n).j_l = j_left
        'snakeMemory(n).j_r = j_right
        'snakeMemory(n).j_t = j_top
        'snakeMemory(n).j_b = j_bottom
        snakeMemory(n).hx = head.X
        snakeMemory(n).hy = head.Y
 
        snakeMemory(n).decision = 0
 
        REDIM _PRESERVE snakeMemory(n + 1) AS snake_memory_type
 
        snakeBrain = n
    END IF
 
    SELECT CASE decision
        CASE 0
            'things will be same
        CASE 1
            change.X = -1: change.Y = 0
        CASE 2
            change.X = 1: change.Y = 0
        CASE 3
            change.X = 0: change.Y = -1
        CASE 4
            change.X = 0: change.Y = 1
    END SELECT
 
    preSLen = sLen
END FUNCTION
 
SUB addExperience (c AS XY)
    DIM n AS LONG, d
    DIM f_right, f_left, f_top, f_bottom, sn_right, sn_left, sn_top, sn_bottom, i
 
 
    IF fruit.X - head.X > 0 THEN f_right = 1 ELSE f_left = 1
    IF fruit.Y - head.Y > 0 THEN f_bottom = 1 ELSE f_top = 1
 
    'IF fruit.X - head.X = -1 THEN j_left = 1
    'IF fruit.X - head.X = 1 THEN j_right = 1
    'IF fruit.Y - head.Y = -1 THEN j_top = 1
    'IF fruit.Y - head.Y = 1 THEN j_bottom = 1
    IF c.X = 0 AND c.Y = 0 THEN d = 0
    IF c.Y = 0 THEN
        IF c.X = -1 THEN d = 1 ELSE d = 2
    END IF
    IF c.X = 0 THEN
        IF c.Y = -1 THEN d = 3 ELSE d = 4
    END IF
 
    sn_left = snakeBodyExists(1, -1)
    sn_right = snakeBodyExists(1, 1)
    sn_top = snakeBodyExists(2, -1)
    sn_bottom = snakeBodyExists(2, 1)
 
 
    FOR i = 0 TO UBOUND(snakeMemory) - 1
        'check if the current experiece exists in snake memory, so it can use that decision now.
        if snakeMemory(i).sn_l = sn_left and snakeMemory(i).sn_r = sn_right and _
        snakeMemory(i).sn_t = sn_top and snakeMemory(i).sn_b = sn_bottom and _
        snakeMemory(i).fr_l = f_left and snakeMemory(i).fr_r = f_right and _
        snakeMemory(i).fr_t = f_top and snakeMemory(i).fr_b = f_bottom  then
            snakeMemory(i).decision = d
            EXIT SUB
        END IF
    NEXT
 
    'add new experiece to snake brain
    n = UBOUND(snakeMemory)
 
    snakeMemory(n).sn_l = sn_left
    snakeMemory(n).sn_r = sn_right
    snakeMemory(n).sn_t = sn_top
    snakeMemory(n).sn_b = sn_bottom
 
    snakeMemory(n).fr_l = f_left
    snakeMemory(n).fr_r = f_right
    snakeMemory(n).fr_t = f_top
    snakeMemory(n).fr_b = f_bottom
 
    'snakeMemory(n).j_l = j_left
    'snakeMemory(n).j_r = j_right
    'snakeMemory(n).j_t = j_top
    'snakeMemory(n).j_b = j_bottom
    snakeMemory(n).hx = head.X
    snakeMemory(n).hy = head.Y
 
    snakeMemory(i).decision = d
 
    REDIM _PRESERVE snakeMemory(n + 1) AS snake_memory_type
 
 
END SUB
 
FUNCTION distFromBody (which%, direction%) 'which%: 1=x-axis, 2=y-axis, direction%:1 = right,bottom, -1=left,top
    'return the min distance of snake body from its head in a given direction and axis.
    IF sLen = 1 THEN EXIT FUNCTION
    DIM n, tmp
    tmp = 1000
    FOR n = 1 TO sLen - 1
        IF which% = 1 THEN
            IF direction% = 1 THEN
                IF snake(n).Y = head.Y AND snake(n).X > head.X THEN
                    IF (snake(n).X - head.X) < tmp THEN
                        distFromBody = snake(n).X - head.X
                        tmp = distFromBody
                    END IF
                END IF
            ELSE
                IF snake(n).Y = head.Y AND snake(n).X < head.X THEN
                    IF (head.X - snake(n).X) < tmp THEN
                        distFromBody = head.X - snake(n).X
                        tmp = distFromBody
                    END IF
                END IF
            END IF
        ELSE
            IF direction% = 1 THEN
                IF snake(n).X = head.X AND snake(n).Y > head.Y THEN
                    IF (snake(n).Y - head.Y) < tmp THEN
                        distFromBody = snake(n).Y - head.Y
                        tmp = distFromBody
                    END IF
                END IF
            ELSE
                IF snake(n).X = head.X AND snake(n).Y < head.Y THEN
                    IF (head.Y - snake(n).Y) < tmp THEN
                        distFromBody = head.Y - snake(n).Y
                        tmp = distFromBody
                    END IF
                END IF
            END IF
        END IF
    NEXT
END FUNCTION
FUNCTION snakeBodyExists (which%, direction%)
    IF sLen = 1 THEN EXIT FUNCTION
    DIM n
    FOR n = 1 TO sLen - 1
        IF which% = 1 THEN 'x-direction
            IF direction% = 1 THEN
                IF snake(n).X - head.X > 0 AND snake(n).Y = head.Y THEN snakeBodyExists = 1: EXIT FUNCTION
            ELSE
                IF snake(n).X - head.X < 0 AND snake(n).Y = head.Y THEN snakeBodyExists = 1: EXIT FUNCTION
            END IF
        ELSEIF which% = 2 THEN 'y-direction
            IF direction% = 1 THEN
                IF snake(n).Y - head.Y > 0 AND snake(n).X = head.X THEN snakeBodyExists = 1: EXIT FUNCTION
            ELSE
                IF snake(n).Y - head.Y < 0 AND snake(n).X = head.X THEN snakeBodyExists = 1: EXIT FUNCTION
            END IF
        END IF
    NEXT
END FUNCTION
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
 

[ This attachment cannot be displayed inline in 'Print Page' view ]

Title: Re: Smart Snake
Post by: SMcNeill on March 23, 2020, 09:54:22 am

Wouldn't the "perfect" snake be one which filled the whole screen, with the head and tail separated by a single space where the fruit would appear?

If someone were to draw this image out on a sheet of paper, you'd then have a closed loop which all you'd have to do is follow the exact same path over and over around the screen, until the screen was perfectly filled.

For example, on a 4x4 screen, I have a snake 15 units long (0 to E):

0123
A94
EB85
DC76

0 is the head of the snake, E is the tail of the snake, 0-E is the sequential segments of the snake. Move the head (0) to the blank spot and let the snake follow as it's pulled naturally along. The open space is now where the tail was (E) and the tail is now where (D) was.

It's a closed circuit which travels every point of our screen, until it repeats itself. As long as we repeat this pattern endlessly, we'll end up collecting fruits until our snake fills the whole screen.

Unless something is wrong with my logic -- which is always possible!

Title: Re: Smart Snake
Post by: Ashish on March 23, 2020, 10:22:10 am

@SMcNeill Your approach is what @bplus did in his reply #4 and reply #14.
But you can clearly see it taking more moves. So, I just thought for reducing it by doing it more intelligently. (But my AI is not able to complete the task...)
See my reply #8.

Title: Re: Smart Snake
Post by: bplus on March 23, 2020, 11:53:17 am

@Ashish

Very ambitious trying deep learning but I don't know how you say there are only 512 patterns, more like number of stars or sand... 400 places of fruit minus where snake is times 400 places of snake head times all the places snake body can be around the head.... I watch yours run and I'd swear it seems to learn for a bit and get a little better and then cycle back to learning first lessons again. ie the straight line crash, to the jiggles, to a couple of snake squiggles and wraps and then back again to straight line crashes...

and to think when you get down to last step of perfect run, there is no place left.

@SMcNeill
As Ashish points out this thread started with an example of perfect run.

Put the snake on a circuit that covers the whole board and does not cross over itself then no matter where the fruit goes, the snake will get it and grow.

The trouble with that is the fruit is easy to get at the beginning and growing can be sped up until you reach a point where you need to safely coil the snake before going after the fruit.

Here is what I am working on at moment, you get a guaranteed 40 segments added and from then on it is pure luck how long the snake will last. Also included is commented out abandoned Fake Fruit idea, and commented out section that tries to transition from free fruit flight to safe coiling before going after fruit. I even have another track built in and if I switched to that from the start we'd have one perfectly fat snake but slow as dickens at start getting fruit. But so far switching from free fruit flight that looks very smart to dumb track running is causing crash after crash.

Code: QB64: [Select]

OPTION _EXPLICIT
DEFINT A-Z
_TITLE "Snake AI-1_8 Trail Blazer" 'b+ 2020-03-21 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 Trail Blazer
' 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 sqaure attack pattern
 
' 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 '                                                                  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
 
DIM SHARED yHeadLimit
 
'   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 = .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 - 1: fruit.Y = sqrsY - 1
'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
        '=========================================================================================
 
        '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, 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
 
    'bplus using for test of brain 4
    LINE (0, yHeadLimit * sq)-(xmax, ymax), &H11FFFFFF, 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, 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
            ' 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
 
'SUB snakeBrainBplus 4 ' fake fruit test 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
 
'    'fake fruit variables
'    STATIC lastSLen, goals(1 TO 40) AS XY, topGoal
 
 
'    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"
 
'    'fake fruit  before releaseing snake to persue real fruit, we setup some fale fruit goals
'    'to persue first in order to safely coil the snake so it's doesn't entangle itself and
'    ' choke itelf of access to fruit
'    IF sLen > lastSLen THEN
'        'make goals list  if hasn't been made yet
'        IF goals(2).Y <> sqrsY - 1 THEN
'            goals(1).X = 0: goals(1).Y = 0
'            goals(2).X = 0: goals(2).Y = sqrsY - 1
'            goals(3).X = sqrsX - 1: goals(3).Y = sqrsY - 1
'            i = 4
'            WHILE i + 1 < sqrsY * 2
'                goals(i).X = sqrsX - 1: goals(i).Y = goals(i - 1).Y - 1
'                goals(i + 1).X = 1: goals(i + 1).Y = goals(i).Y
'                goals(i + 2).X = 1: goals(i + 2).Y = goals(i).Y - 1
'                goals(i + 3).X = sqrsX - 1: goals(i + 3).Y = goals(i + 2).Y
'                i = i + 4
'            WEND
'        END IF 'list not made yet
'        topGoal = sLen \ 20 'set new goal
'        lastSLen = sLen 'reset checker
'    END IF
'    IF topGoal THEN
'        IF head.X = goals(topGoal).X AND head.Y = goals(topGoal).Y THEN topGoal = topGoal - 1
'        IF topGoal THEN map(goals(topGoal).X, goals(topGoal).Y) = "F" ELSE map(fruit.X, fruit.Y) = "F"
'    ELSE
'        map(fruit.X, fruit.Y) = "F"
'    END IF
'    'ok false fruit or fruit target set for pathfinder
 
'    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
 
 
SUB snakeBrainBplus4 ' real AI, responds to real time information
    'STATIC xLim, yLim, dat$(sqrsX - 1, sqrsY - 1)
    DIM xlim, ylim, bodyStack
    xlim = sqrsX - 1: ylim = sqrsY - 1
    'IF dat$(0, 0) <> "D" THEN GOSUB setupdat 'haven't been here yet
 
    bodyStack = INT(sLen / 40) 'these are integers so 0 for first 40
    yHeadLimit = ylim - bodyStack * 2 + 1
 
    'IF head.Y >= yHeadLimit THEN '<<<<<<<<<<<<<<<<< go up om even when stacking
    'IF head.X MOD 2 = 0 THEN 'even row  includes top row
    '    IF head.X = 0 THEN
    '        IF head.Y <> ylim THEN
    '            change.X = 0: change.Y = 1
    '        ELSE
    '            change.X = 1: change.Y = 0
    '        END IF
    '    ELSEIF head.X = 1 THEN
    '        IF head.Y <> 0 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
    '        change.X = -1: change.Y = 0
    '    ELSEIF head.X = xlim THEN
    '        change.X = -1: change.Y = 0
    '    END IF
    'ELSE 'head.x mod 2 = 1  'includes bottom row
 
    '    IF head.X = 0 THEN
    '        IF head.Y = ylim THEN
    '            change.X = 1: change.Y = 0
    '        ELSE
    '            change.X = 0: change.Y = 1
    '        END IF
    '    ELSEIF head.X >= 1 AND head.X <> xlim THEN 'crashing on bottom line
    '        change.X = 1: change.Y = 0
    '    ELSEIF head.X = xlim THEN
    '        change.X = 0: change.Y = -1
    '    END IF
    'END IF
    'ELSE ' head.y < yheadlimit
    IF head.X = 0 THEN
        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
        IF head.Y = ylim THEN
            change.X = 1: change.Y = 0
        ELSE
            change.X = -1: change.Y = 0
        END IF
    ELSEIF head.X = xlim THEN
        IF head.Y = 0 THEN
            change.X = -1: change.Y = 0
        ELSEIF head.Y = fruit.Y AND fruit.Y < ylim THEN
            change.X = -1: change.Y = 0
        ELSE
            change.X = 0: change.Y = -1
        END IF
    END IF
    'END IF
    EXIT SUB
 
    '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
 

Title: Re: Smart Snake
Post by: bplus on March 23, 2020, 10:46:45 pm

I got it! A Smarter Snake that combines "real AI" with dumb track running to coil a long snake body out of it's own way.
SnakeBrainBplus4 "Trailblazer"

Code: QB64: [Select]

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
 
 

I changed up sqrsX, sqrsY the number of squares across and up/down to show the AI is not stuck with one size snakepit.

Title: Re: Smart Snake
Post by: Ashish on March 24, 2020, 05:22:51 am

Congratulations @bplus ! :D

Quote from: bplus on March 23, 2020, 11:53:17 am

@Ashish
Very ambitious trying deep learning but I don't know how you say there are only 512 patterns...

By possible situation I meant how many condition can be made on line 279 of code in reply #23.
In the IF...THEN clause, there are 8 variables that are being used. Each variable can either be true or false.
So, the total number of possible condition is 2^8 or 256.

Oh! Did I write 512? Forgive me. ;)

Title: Re: Smart Snake
Post by: bplus on March 24, 2020, 10:45:37 am

Thanks Ashish, glad someone get's it!

For your 8 conditions and learning, can you summarize in English what you are attempting with code?

With only bits 0 or 1, I am not sure your snake can even learn the 4 boundaries. That might be an interesting experiment but would need to store learning between program executions so we don't have to start all over again each time run program.

Title: Re: Smart Snake
Post by: Ashish on March 25, 2020, 05:35:40 am

forget about it @bplus
As I stated in my post, that is based on what I imagine the deep learning models would be like.
With only bits 0 and 1, I just give it a particular decision for a particular combination of 0 & 1. If it cause an AI error, then I change the decision.
If it doesn't cause any error, then things remain same.
Interestingly, it seems to learn for a moment and then it restart to learn the first lesson again. (LOL)
IDK what is happening behind, but I can say a GOOD AI programmer would develop very perfect model for your snake. :)

Title: Re: Smart Snake
Post by: bplus on March 25, 2020, 11:16:33 am

Quote

but I can say a GOOD AI programmer would develop very perfect model for your snake. :)

He did! ;) perfect given it's lines of code, resource usage and minimum amount of brains to understand.

Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on March 15, 2020, 01:39:16 pm