Author Topic: Smart Snake  (Read 2073 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Forum Resident
  • Posts: 7118
  • b = b + ...
Re: Smart Snake
« Reply #15 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.
« Last Edit: March 20, 2020, 10:37:18 AM by bplus »

Offline TempodiBasic

  • Forum Resident
  • Posts: 1706
Re: Smart Snake
« Reply #16 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
;-)
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Forum Resident
  • Posts: 7118
  • b = b + ...
Re: Smart Snake
« Reply #17 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.
« Last Edit: March 21, 2020, 11:09:43 AM by bplus »

Offline bplus

  • Forum Resident
  • Posts: 7118
  • b = b + ...
Re: Smart Snake
« Reply #18 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]
  1. _TITLE "Snake AI-1_7 Real AI" 'b+ 2020-03-20 and Ashish SUB snakeBrainAshish1
  2.  
  3. '2020-03-14 Snake AI-1 first post
  4. '2020-03-16  Snake AI-1_1 there must be overlap of the snake somewhere! Aha!
  5. '2020-03-17 Snake AI-1_2 fix the duplicate segment problem
  6. ' Now a new mystery, an ocassional flashing duplicate box
  7. '2020-03-17 Install standard snake rules for testing brain evolving
  8. ' First setup XY type and rename and convert variables using XY type.
  9. ' 2nd Make snake brain and whole game only dependent sqrsX, sqrsY and sq for screen size
  10. ' Got it!!! the code ends with hangup head next to fruit with 99 (1 cell less that whole board)
  11. ' cells of snake length, no new place can be found for fruit, perfect finish and no duplicate
  12. ' cells! PLUS now can turn on a dime go up one colume and down the next in 2 key press.
  13. ' Now add autoPilot on -1 / off 0 toggle control, OK snake rules tested when human pilots snake.
  14. ' Help screen & independent speeds for human or AI.
  15. '2020-03-18  "Snake AI-1_4 fix tester" The AI tester needs to save Head(x, y) in case the AI
  16. ' does not change the head(x, y) or tries to move it diagonally.
  17. '2020-03-18 Snake AI-1_5 SHARE change AS XY
  18. ' DIM SHARE change AS XY or change.x, change.y replaces variables called dx, dy.
  19. ' I decided to switch over to human control if AI fails to return a proper change.
  20. ' AI must leave change.x, change.y ready for human to take over control which means my changing
  21. ' the code for toggling the autopilot and adding change.x, change.y updates in my snakeBrain SUB.
  22. ' Rewrite SnakeBrain using only change.X and change.Y now. A BEEP will indicate an AI error and
  23. ' signal control returned to human. This noted in Key Help part of screen.
  24. '2020-03-19 Snake AI-1_6 B+brain#2 begin a new snakeBrainBplus2 sub routine
  25. ' Add a driver report in title bar along with sLen.
  26. ' Oh hey what a fancy snake dance, not the least bit faster than snakeBrainBplus1.
  27.  
  28. '2020-03-20 Snake AI-1_7 real AI
  29. ' RE: snakeBrainBplus2
  30. ' Recode snakeBrainBplus2 to be self contained in one SUB, load data for the array it uses inside
  31. ' that SUB. It also has to check sqrsX, sqrsY to be sure they are correct, this is pure novelty
  32. ' SUB so will set sqrsX, sqrsY back to 20 each for standard game AI setting. OK good!
  33.  
  34. ' RE: sqrsX, sqrsY
  35. ' sqrsX, sqrsY reset back to 20, 20 for standard setup for testing AI.
  36.  
  37. ' RE: Ashish first "real AI" very excellent submission!
  38. ' Attempt to incorporate Ashish "real AI" as SUB snakeBrainAshish1
  39. ' Ashish is using $CONSOLE and DIM SHARED state$ but I don't see why so I made state$ STATIC in
  40. ' his SUB and took console out, though I can see it might be needed later. Working here yeah!
  41.  
  42. ' RE: SnakeBrainBplus3, bplus first "real AI" also working pretty well to a point.
  43. ' SnakeBrainBplus3 uses real AI and crashes when snake can't get to fruit due to it's length
  44. ' either by inaccessible fruit, snakes body blocks head or head buried in body and can't escape.
  45. ' Using lessons learned from Pathfinder work.
  46.  
  47. ' Snakepit Dimensions: square size = sq, sqrsX = # of squares along x-axis and sqrsY squares down.
  48. CONST sq = 20, sqrsX = 20, sqrsY = 20, xmax = sq * sqrsX, ymax = sq * sqrsY
  49. SCREEN _NEWIMAGE(800, 600, 32)
  50. _DELAY .25
  51.  
  52. 'Usually used to give a point on 2D board a single name that has an X dimension and a Y dimension.
  53. TYPE XY
  54.     X AS INTEGER
  55.     Y AS INTEGER
  56.  
  57. '   SHARED variables for any version of SnakeBrain SUB to act as autoPilot for snake snake.
  58. DIM SHARED change AS XY '                           directs the head direction through AI or Human
  59. DIM SHARED head AS XY '                          leads the way of the snake(body) through snakepit
  60. DIM SHARED sLen AS INTEGER '                                                       length of snake
  61. DIM SHARED snake(1 TO sqrsX * sqrsY) AS XY '                  whole snake, head is at index = sLen
  62. DIM SHARED fruit AS XY '    as snake eats fruit it grows, object is to grow snake to fill snakepit
  63.  
  64.  
  65. '   SHARED for screenUpdate
  66. DIM SHARED pal(sqrsX * sqrsY) AS _UNSIGNED LONG '                                 for snake colors
  67.  
  68. 'other data needed for program
  69. DIM autoPilot AS INTEGER, hSpeed, aSpeed, saveChange AS XY, title$
  70.  
  71. help '                                                                                    Key Menu
  72. hSpeed = 3: aSpeed = 20 '                    autopilot speed is independent of human control speed
  73.  
  74. restart: '                                                                            reinitialize
  75. r = .3 + RND * .7: g = r * .5 + RND * .3 - .15: b = .5 * r + RND * .3 - .15 '   rnd pal color vars
  76. FOR i = 1 TO sqrsX * sqrsY '                              enough colors for snake to fill snakepit
  77.     pal(i) = _RGB32(84 + 64 * SIN(r + i / 2), 84 + 64 * SIN(g + i / 2), 104 * SIN(b + i / 2))
  78. head.X = sqrsX / 2 - 3: head.Y = sqrsY / 2 - 3 '                                        head start
  79. fruit.X = sqrsX / 2 + 2: fruit.Y = sqrsY / 2 + 2 '                                     first fruit
  80. sLen = 1 '                                                          for starters snake is all head
  81. snake(sLen).X = head.X: snake(sLen).Y = head.Y '                        head is always at sLen end
  82. autoPilot = 1 '                                                             start snake body count
  83. change.X = 0: change.Y = 1 '                     head snake down board, Y direction of first fruit
  84.     IF autoPilot THEN title$ = "AI." ELSE title$ = "human."
  85.     _TITLE STR$(sLen) + " Current driver is " + title$
  86.     LINE (0, 0)-(xmax, ymax), &HFF884422, BF '                                      clear snakepit
  87.     IF sLen = sqrsX * sqrsY - 1 THEN screenUpdate: EXIT DO '            game is won! start another
  88.     KEY$ = INKEY$
  89.     IF KEY$ = "q" OR KEY$ = CHR$(27) THEN '                                           here is quit
  90.         END '
  91.     ELSEIF KEY$ = "a" THEN '                                                      toggle autoPilot
  92.         autoPilot = 1 - autoPilot '  it is now up to AI to keep change updated for human take over
  93.     ELSEIF KEY$ = "p" THEN '                              pause toggle p starts pause p ends pause
  94.         _KEYCLEAR: WHILE INKEY$ <> "p": _LIMIT 60: WEND
  95.     ELSEIF KEY$ = "s" THEN
  96.         IF autoPilot AND aSpeed + 5 < 400 THEN aSpeed = aSpeed + 5 'max autopilot speed is 400 !!!
  97.         IF autoPilot = 0 AND hSpeed + .5 < 10 THEN hSpeed = hSpeed + .5 '    max human speed is 10
  98.     ELSEIF KEY$ = "-" THEN
  99.         IF autoPilot AND aSpeed - 5 > 0 THEN aSpeed = aSpeed - 5
  100.         IF autoPilot = 0 AND hSpeed - .5 > 1 THEN hSpeed = hSpeed - .5
  101.     END IF '                                                                                      '
  102.  
  103.     IF autoPilot THEN '                                                 who is piloting the snake?
  104.  
  105.         saveChange.X = change.X: saveChange.Y = change.Y '   if AI screws up then human takes over
  106.  
  107.         ' PLUG-IN YOUR Snake Brain AI here
  108.         '=========================================================================== AI Auto Pilot
  109.         'snakeBrainBplus1 '        dumb track AI but always gets it's fruit! requires even # sqrsX
  110.         'snakeBrainBplus2 '    dumb track AI but looks cool! requirescustom sqrsX = 17, sqrsY = 16
  111.         'snakeBrainAshish1 '     first "realAI" I would call an heuristic approach, thanks Ashish!
  112.         snakeBrainBplus3 '                 bplus "first real AI" uses modified Pathfinder methods
  113.         '=========================================================================================
  114.  
  115.         'check changes
  116.         IF ABS(change.X) = 0 THEN '                                      must have diffence in y's
  117.             IF ABS(change.Y) <> 1 THEN autoPilot = 0 '                       error switch to human
  118.         ELSEIF ABS(change.Y) = 0 THEN
  119.             IF ABS(change.X) <> 1 THEN autoPilot = 0 '                       error switch to human
  120.         ELSE '                           must have a 0 in either change.x or change.y but not both
  121.             autoPilot = 0 '                                                  error switch to human
  122.         END IF
  123.         IF autoPilot = 0 THEN '              switching control over to human restore change values
  124.             change.X = saveChange.X: change.Y = saveChange.Y: BEEP '                   alert human
  125.         END IF
  126.  
  127.     ELSE '  =======================================================================  human control
  128.         IF KEY$ = CHR$(0) + CHR$(72) THEN '                                               up arrow
  129.             change.X = 0: change.Y = -1
  130.         ELSEIF KEY$ = CHR$(0) + CHR$(80) THEN '                                         down arrow
  131.             change.X = 0: change.Y = 1
  132.         ELSEIF KEY$ = CHR$(0) + CHR$(77) THEN '                                        right arrow
  133.             change.X = 1: change.Y = 0
  134.         ELSEIF KEY$ = CHR$(0) + CHR$(75) THEN '                                         left arrow
  135.             change.X = -1: change.Y = 0
  136.         END IF
  137.  
  138.     END IF
  139.     head.X = head.X + change.X: head.Y = head.Y + change.Y '            OK human or AI have spoken
  140.  
  141.     '   ============================  check snake head with Rules: ===============================
  142.  
  143.     ' 1. Snakepit boundary check, snake hits wall, dies.
  144.     IF head.X < 0 OR head.X > sqrsX - 1 OR head.Y < 0 OR head.Y > sqrsY - 1 THEN
  145.         _TITLE _TRIM$(STR$(sLen)) + " Wall Crash": screenUpdate: EXIT DO '    wall crash, new game
  146.     END IF
  147.  
  148.     ' 2. Snake eats body part, dies. This should kill snake if turn its head back on itself.
  149.     FOR i = 1 TO sLen '                                             did head just crash into body?
  150.         IF head.X = snake(i).X AND head.Y = snake(i).Y THEN
  151.             _TITLE _TRIM$(STR$(sLen)) + " Body Crash": screenUpdate: EXIT DO ' yes! start new game
  152.         END IF
  153.     NEXT '                                                                                      no
  154.  
  155.     ' 3. Eats Fruit and grows or just move every segment up 1 space.
  156.     IF (fruit.X = head.X AND fruit.Y = head.Y) THEN '                             snake eats fruit
  157.         sLen = sLen + 1
  158.         snake(sLen).X = head.X: snake(sLen).Y = head.Y 'assimilate fruit into head for new segment
  159.         DO 'check new apple
  160.             fruit.X = INT(RND * sqrsX): fruit.Y = INT(RND * sqrsY): good = -1
  161.             FOR i = 1 TO sLen
  162.                 IF fruit.X = snake(i).X AND fruit.Y = snake(i).Y THEN good = 0: EXIT FOR
  163.             NEXT
  164.         LOOP UNTIL good
  165.     ELSE
  166.         FOR i = 1 TO sLen '                           move the snake data down 1 dropping off last
  167.             snake(i).X = snake(i + 1).X: snake(i).Y = snake(i + 1).Y
  168.         NEXT
  169.         snake(sLen).X = head.X: snake(sLen).Y = head.Y '              and adding new head position
  170.     END IF
  171.  
  172.     screenUpdate '                                                    on with the show this is it!
  173.     IF autoPilot THEN _LIMIT aSpeed ELSE _LIMIT hSpeed 'independent speed control for human and AI
  174. _DELAY 4 '                                                                  win or loose, go again
  175. GOTO restart:
  176.  
  177. SUB screenUpdate ' draw snake and fruit, overlap code debugger
  178.     DIM c~&, i AS INTEGER, overlap(sqrsX, sqrsY) AS INTEGER
  179.     FOR i = 1 TO sLen
  180.         IF i = sLen THEN c~& = &HFF000000 ELSE c~& = pal(sLen - i)
  181.  
  182.         '               overlap helps debug duplicate square drawing which indicates a flawed code
  183.         overlap(snake(i).X, snake(i).Y) = overlap(snake(i).X, snake(i).Y) + 1
  184.  
  185.         LINE (snake(i).X * sq, snake(i).Y * sq)-STEP(sq - 2, sq - 2), c~&, BF
  186.         IF overlap(snake(i).X, snake(i).Y) > 1 THEN 'show visually where code flaws effect display
  187.             LINE (snake(i).X * sq + .25 * sq, snake(i).Y * sq + .25 * sq)_
  188.             -STEP(.5 * sq - 2, .5 * sq - 2), &HFFFFFFFF, BF
  189.         END IF
  190.     NEXT
  191.     LINE (fruit.X * sq, fruit.Y * sq)-STEP(sq - 2, sq - 2), _RGB32(255, 100, 255), BF
  192.     _DISPLAY
  193.  
  194. SUB help
  195.     _PRINTSTRING (610, 20), "Keys:"
  196.     _PRINTSTRING (610, 40), "p toggles pause on/off"
  197.     _PRINTSTRING (610, 60), "a toggles autoPilot"
  198.     _PRINTSTRING (610, 100), "arrows control snake"
  199.     _PRINTSTRING (610, 80), "q or esc quits"
  200.     _PRINTSTRING (610, 120), "s increases speed"
  201.     _PRINTSTRING (610, 140), "- decreases speed"
  202.     _PRINTSTRING (610, 200), "A BEEP means AI error,"
  203.     _PRINTSTRING (610, 216), "human put in control."
  204.  
  205. 'basic functions added for snakeBrainBplus3 (bplus first real AI)
  206.     IF n > m THEN max = n ELSE max = m
  207.  
  208.     IF n < m THEN min = n ELSE min = m
  209.  
  210. ' ================================================================= end code that runs Snake Games
  211.  
  212. SUB snakeBrainBplus1 '>>>>>>>>>>   B+  SNAKE BRAIN  needs sqrsX to be even number  <<<<<<<<<<<<<<<
  213.     ' This will be handy for standard 20x20 snakepit to dove tail real AI towrds.
  214.     'todo fix this so that when takeover control won't crash into self
  215.  
  216.     IF sqrsX MOD 2 = 1 THEN change.X = 0: change.Y = 0: EXIT SUB '   throw error for code check to
  217.     '                                                         discover and switch to human control
  218.  
  219.     IF head.X = 0 AND head.Y = sqrsY - 1 THEN
  220.         change.X = 0: change.Y = -1
  221.     ELSEIF head.X MOD 2 = 0 AND head.Y <> 0 AND head.Y <> sqrsY - 1 THEN
  222.         change.X = 0: change.Y = -1
  223.     ELSEIF head.X MOD 2 = 0 AND head.Y = 0 AND head.Y <> sqrsY - 1 THEN
  224.         change.X = 1: change.Y = 0
  225.     ELSEIF head.X MOD 2 = 1 AND head.X <> sqrsX - 1 AND head.Y = sqrsY - 2 THEN
  226.         change.X = 1: change.Y = 0
  227.     ELSEIF head.X MOD 2 = 1 AND head.X <> sqrsX - 1 AND head.Y < sqrsY - 1 THEN
  228.         change.X = 0: change.Y = 1
  229.     ELSEIF head.X = sqrsX - 1 AND head.Y = sqrsY - 1 THEN
  230.         change.X = -1: change.Y = 0
  231.     ELSEIF head.Y = sqrsY - 1 AND head.X <> 0 THEN
  232.         change.X = -1: change.Y = 0
  233.     ELSEIF head.X MOD 2 = 1 AND head.Y = 0 AND head.Y <> sqrsY - 1 THEN
  234.         change.X = 0: change.Y = 1
  235.     ELSEIF head.X = sqrsX - 1 AND head.Y < sqrsY - 1 THEN
  236.         change.X = 0: change.Y = 1
  237.     END IF
  238.  
  239. SUB snakeBrainBplus2 '   Needs custom sqrsX = 17, sqrsY = 16 This is mainly a novelty SUB for fun!
  240.     'A good AI will NOT require a custom sqrsX = 17, sqrsY = 16
  241.     IF sqrsX <> 17 OR sqrsY <> 16 THEN change.X = 0: change.Y = 0: EXIT SUB ' throw error for code
  242.     '                                                check to discover and switch to human control
  243.  
  244.     DIM x, y, s$, direction$
  245.     STATIC brain2Directions(sqrsX - 1, sqrsY - 1) AS STRING
  246.  
  247.     IF brain2Directions(0, 0) <> "R" THEN GOSUB loadBrain2Directions 'array not loaded yet so load
  248.     direction$ = brain2Directions(head.X, head.Y)
  249.     SELECT CASE direction$
  250.         CASE "U": change.X = 0: change.Y = -1
  251.         CASE "D": change.X = 0: change.Y = 1
  252.         CASE "L": change.X = -1: change.Y = 0
  253.         CASE "R": change.X = 1: change.Y = 0
  254.     END SELECT
  255.     EXIT SUB
  256.     loadBrain2Directions:
  257.     FOR y = 0 TO sqrsY - 1
  258.         READ s$
  259.         FOR x = 0 TO sqrsX - 1
  260.             brain2Directions(x, y) = MID$(s$, x + 1, 1)
  261.         NEXT
  262.     NEXT
  263.     RETURN
  264.  
  265.     DATA RRRRRRRRRRRRRRRRD
  266.     DATA UDLLLLLLLLLLLLLLD
  267.     DATA UDRRRRRRRRRRRRDUD
  268.     DATA UDUDLLLLLLLLLLDUD
  269.     DATA UDUDRRRRRRRRDUDUD
  270.     DATA UDUDUDLLLLLLDUDUD
  271.     DATA UDUDUDRRRRDUDUDUD
  272.     DATA UDUDUDUDLLDUDUDUD
  273.     DATA UDUDUDUDRUDUDUDUD
  274.     DATA UDUDUDUDULLUDUDUD
  275.     DATA UDUDUDURRRRUDUDUD
  276.     DATA UDUDUDULLLLLLUDUD
  277.     DATA UDUDURRRRRRRRUDUD
  278.     DATA UDUDULLLLLLLLLLUD
  279.     DATA UDURRRRRRRRRRRRUD
  280.     DATA ULULLLLLLLLLLLLLL
  281.  
  282.     '        note: I had the following lines in main code delares section in case OPTION _EXPLICIT
  283.     ' started alerts about DIM the STATIC variable in main but not needed.
  284.     '
  285.     '   I think OPTION _EXPLICIT requires next line but will make snakeBrainBplus2 self contained.
  286.     'DIM SHARED brain2Directions(0 TO sqrsX - 1, 0 TO sqrsY - 1) AS STRING ' 4 snakeBrainBplus2 AI
  287.  
  288.  
  289. SUB snakeBrainAshish1 'needs supplemental  FUNCTION snakeBodyExists (which%)
  290.     DIM nx, ny, dx, dy 'Ashish AI
  291.     STATIC decided
  292.     STATIC state$ '    bplus added state$ to SUB here and removed from DIM SHARED in Main Declares
  293.     dx = fruit.X - head.X
  294.     dy = fruit.Y - head.Y
  295.     nx = snakeBodyExists(1)
  296.     ny = snakeBodyExists(2)
  297.     IF sLen > 1 THEN 'collison at corners of square
  298.         IF head.X = 0 AND head.Y = 0 THEN
  299.             state$ = "corners"
  300.             IF change.X = -1 THEN change.X = 0: change.Y = 1: decided = 0: EXIT SUB
  301.             IF change.Y = -1 THEN change.Y = 0: change.X = 1: decided = 0: EXIT SUB
  302.         ELSEIF head.X = 0 AND head.Y = sqrsY - 1 THEN
  303.             state$ = "corners"
  304.             IF change.X = -1 THEN change.X = 0: change.Y = -1: decided = 0: EXIT SUB
  305.             IF change.Y = 1 THEN change.Y = 0: change.X = 1: decided = 0: decided = 0: EXIT SUB
  306.         ELSEIF head.X = sqrsX - 1 AND head.Y = 0 THEN
  307.             state$ = "corners"
  308.             IF change.X = 1 THEN change.X = 0: change.Y = 1: decided = 0: EXIT SUB
  309.             IF change.Y = -1 THEN change.Y = 0: change.X = -1: decided = 0: EXIT SUB
  310.         ELSEIF head.X = sqrsX - 1 AND head.Y = sqrsY - 1 THEN
  311.             state$ = "corners"
  312.             IF change.X = 1 THEN change.X = 0: change.Y = -1: decided = 0: EXIT SUB
  313.             IF change.Y = 1 THEN change.Y = 0: change.X = -1: decided = 0: EXIT SUB
  314.         END IF
  315.         IF decided = 0 THEN 'collision with walls
  316.             IF head.X = sqrsX - 1 OR head.X = 0 THEN
  317.                 state$ = "walls"
  318.                 IF ny = 0 THEN
  319.                     IF dy > 0 THEN ny = -1 ELSE ny = 1
  320.                 END IF
  321.                 change.Y = ny * -1: change.X = 0
  322.                 decided = 1
  323.                 EXIT SUB
  324.             ELSEIF head.Y = sqrsY - 1 OR head.Y = 0 THEN
  325.                 state$ = "walls"
  326.                 IF nx = 0 THEN
  327.                     IF dx > 0 THEN nx = -1 ELSE nx = 1
  328.                 END IF
  329.                 change.X = nx * -1: change.Y = 0
  330.                 decided = 1
  331.                 EXIT SUB
  332.             END IF
  333.         END IF
  334.     END IF
  335.     IF dx = 0 THEN 'when fruit and head in same direction and motion in same axis
  336.         IF change.Y = 0 THEN
  337.             state$ = "linear"
  338.             IF dy > 0 AND ny <> 1 THEN
  339.                 change.Y = 1: change.X = 0: decided = 0: EXIT SUB
  340.             ELSEIF dy < 0 AND ny <> -1 THEN
  341.                 change.Y = -1: change.X = 0: decided = 0: EXIT SUB
  342.             END IF
  343.         END IF
  344.     END IF
  345.     IF dy = 0 THEN
  346.         IF change.X = 0 THEN
  347.             state$ = "linear"
  348.             IF dx > 0 AND nx <> 1 THEN
  349.                 change.X = 1: change.Y = 0: decided = 0: EXIT SUB
  350.             ELSEIF dx < 0 AND nx <> -1 THEN
  351.                 change.X = -1: change.Y = 0: decided = 0: EXIT SUB
  352.             END IF
  353.         END IF
  354.     END IF
  355.  
  356.     state$ = "common"
  357.     'common decision
  358.     IF ABS(dx) < ABS(dy) THEN
  359.         state$ = "common ny=" + STR$(ny)
  360.         IF ny = 0 THEN
  361.             change.X = 0
  362.             IF dy > 0 THEN change.Y = 1 ELSE change.Y = -1
  363.             state$ = "common cy=" + STR$(change.Y)
  364.             EXIT SUB
  365.         END IF
  366.         IF dy > 0 AND ny <> 1 THEN change.Y = 1: change.X = 0
  367.         IF dy < 0 AND ny <> -1 THEN change.Y = -1: change.X = 0
  368.         decided = 0
  369.     ELSE
  370.         state$ = "common nx=" + STR$(nx)
  371.         IF nx = 0 THEN
  372.             change.Y = 0
  373.             IF dx > 0 THEN change.X = 1 ELSE change.X = -1
  374.             state$ = "common cx=" + STR$(change.X)
  375.             EXIT SUB
  376.         END IF
  377.         IF dx > 0 AND nx <> 1 THEN change.X = 1: change.Y = 0
  378.         IF dx < 0 AND nx <> -1 THEN change.X = -1: change.Y = 0
  379.         decided = 0
  380.     END IF
  381.  
  382.     state$ = "rand_common"
  383.     IF ABS(dx) = ABS(dy) THEN 'random choice will be made then, rest code is same as above
  384.         IF RND > 0.5 THEN
  385.             state$ = "rand_common ny=" + STR$(ny)
  386.             IF ny = 0 THEN
  387.                 change.X = 0
  388.                 IF dy > 0 THEN change.Y = 1 ELSE change.Y = -1
  389.                 state$ = "rand_common cy=" + STR$(change.Y)
  390.                 EXIT SUB
  391.             END IF
  392.             IF dy > 0 AND ny <> 1 THEN change.Y = 1: change.X = 0
  393.             IF dy < 0 AND ny <> -1 THEN change.Y = -1: change.X = 0
  394.             decided = 0
  395.         ELSE
  396.             state$ = "rand_common nx=" + STR$(nx)
  397.             IF nx = 0 THEN
  398.                 change.Y = 0
  399.                 IF dx > 0 THEN change.X = 1 ELSE change.X = -1
  400.                 state$ = "rand_common cx=" + STR$(change.X)
  401.                 EXIT SUB
  402.             END IF
  403.             IF dx > 0 AND nx <> 1 THEN change.X = 1: change.Y = 0
  404.             IF dx < 0 AND nx <> -1 THEN change.X = -1: change.Y = 0
  405.             decided = 0
  406.         END IF
  407.     END IF
  408.  
  409. FUNCTION snakeBodyExists (which%) ' for SUB snakeBrainAshish1 supplemental
  410.     IF sLen = 1 THEN EXIT FUNCTION
  411.     DIM n
  412.     FOR n = 1 TO sLen - 1
  413.         IF which% = 1 THEN 'x-direction
  414.             IF snake(n).X - head.X > 0 AND snake(n).Y = head.Y THEN snakeBodyExists = 1: EXIT FUNCTION
  415.             IF snake(n).X - head.X < 0 AND snake(n).Y = head.Y THEN snakeBodyExists = -1: EXIT FUNCTION
  416.         ELSEIF which% = 2 THEN 'y-direction
  417.             IF snake(n).Y - head.Y > 0 AND snake(n).X = head.X THEN snakeBodyExists = 1: EXIT FUNCTION
  418.             IF snake(n).Y - head.Y < 0 AND snake(n).X = head.X THEN snakeBodyExists = -1: EXIT FUNCTION
  419.         END IF
  420.     NEXT
  421.  
  422. SUB snakeBrainBplus3 ' real AI, responds to real time information
  423.  
  424.     'needs FUNCTION max (n AS INTEGER, m AS INTEGER),   FUNCTION min (n AS INTEGER, m AS INTEGER)  
  425.  
  426.     'from: Pathfinder inside Maze.bas B+ 2019-12-19 only completely overhauled!
  427.     DIM x AS INTEGER, y AS INTEGER, i AS INTEGER, changeF AS INTEGER
  428.     DIM parentF AS INTEGER, tick AS INTEGER, foundHead AS INTEGER, headMarked AS INTEGER
  429.     DIM yStart AS INTEGER, yStop AS INTEGER, xStart AS INTEGER, xStop AS INTEGER
  430.     DIM map(sqrsX - 1, sqrsY - 1) AS STRING, map2(sqrsX - 1, sqrsY - 1) AS STRING
  431.     FOR y = 0 TO sqrsY - 1
  432.         FOR x = 0 TO sqrsX - 1
  433.             map(x, y) = " "
  434.         NEXT
  435.     NEXT
  436.     FOR i = 1 TO sLen - 1 ' draw snake in map
  437.         map(snake(i).X, snake(i).Y) = "S"
  438.     NEXT
  439.     map(head.X, head.Y) = "H"
  440.     map(fruit.X, fruit.Y) = "F"
  441.     tick = 0
  442.     WHILE parentF OR headMarked = 0
  443.         parentF = 0: tick = tick + 1
  444.         yStart = max(fruit.Y - tick, 0): yStop = min(fruit.Y + tick, sqrsY - 1)
  445.         REDIM map2(sqrsX - 1, sqrsY - 1) AS STRING '    need a 2nd map to hold all new stuff until
  446.         FOR y = 0 TO sqrsY - 1 '                                          the entire square coverd
  447.             FOR x = 0 TO sqrsX - 1
  448.                 map2(x, y) = " "
  449.             NEXT
  450.         NEXT
  451.         FOR y = yStart TO yStop
  452.             xStart = max(fruit.X - tick, 0): xStop = min(fruit.X + tick, sqrsX - 1)
  453.             FOR x = xStart TO xStop
  454.                 'check out the neighbors
  455.                 IF map(x, y) = " " OR map(x, y) = "H" THEN
  456.                     IF map(x, y) = "H" THEN foundHead = -1
  457.                     IF y - 1 >= 0 THEN
  458.                         IF INSTR("UDLRF", map(x, y - 1)) THEN
  459.                             map2(x, y) = "U": parentF = 1
  460.                             IF foundHead THEN headMarked = -1
  461.                         END IF
  462.                     END IF
  463.                     IF y + 1 <= sqrsY - 1 THEN
  464.                         IF INSTR("UDLRF", map(x, y + 1)) THEN
  465.                             map2(x, y) = "D": parentF = 1
  466.                             IF foundHead THEN headMarked = -1
  467.                         END IF
  468.                     END IF
  469.                     IF x + 1 <= sqrsX - 1 THEN
  470.                         IF INSTR("UDLRF", map(x + 1, y)) THEN
  471.                             map2(x, y) = "R": parentF = 1
  472.                             IF foundHead THEN headMarked = -1
  473.                         END IF
  474.                     END IF
  475.                     IF x - 1 >= 0 THEN
  476.                         IF INSTR("UDLRF", map(x - 1, y)) THEN
  477.                             map2(x, y) = "L": parentF = 1
  478.                             IF foundHead THEN headMarked = -1
  479.                         END IF
  480.                     END IF
  481.                 END IF
  482.             NEXT
  483.         NEXT
  484.         FOR y = 0 TO sqrsY - 1 'transfer data to map
  485.             FOR x = 0 TO sqrsX - 1
  486.                 IF map2(x, y) <> " " THEN map(x, y) = map2(x, y): changeF = 1
  487.             NEXT
  488.         NEXT
  489.     WEND 'if no ParentF then dead connection to Fruit
  490.     SELECT CASE map(head.X, head.Y)
  491.         CASE "H" ' cause crash because no connection to fruit found
  492.             IF change.X THEN change.X = -change.X ELSE change.Y = -change.Y 'make Body crash
  493.             ' change.X = 0: change.Y = 0 '   this will switch auto control off to avoid program hang, dang still hangs!
  494.         CASE "D": change.X = 0: change.Y = 1
  495.         CASE "U": change.X = 0: change.Y = -1
  496.         CASE "R": change.X = 1: change.Y = 0
  497.         CASE "L": change.X = -1: change.Y = 0
  498.     END SELECT
  499.  

« Last Edit: March 21, 2020, 01:20:22 PM by bplus »

Offline bplus

  • Forum Resident
  • Posts: 7118
  • b = b + ...
Re: Smart Snake
« Reply #19 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!
« Last Edit: March 22, 2020, 10:43:33 AM by bplus »

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
Re: Smart Snake
« Reply #20 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.
« Last Edit: March 22, 2020, 11:16:40 AM by Ashish »
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
Re: Smart Snake
« Reply #21 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]
  1.  
  2. _TITLE "Snake AI-1_5 SHARE change AS XY" 'b+ 2020-03-18
  3. '2020-03-14 Snake AI-1 first post
  4. '2020-03-16  Snake AI-1_1 there must be overlap of the snake somewhere! Aha!
  5. '2020-03-17 Snake AI-1_2 fix the duplicate segment problem
  6. ' Now a new mystery, an ocassional flashing duplicate box
  7. '2020-03-17 Install standard snake rules for testing brain evolving
  8. ' First setup XY type and rename and convert variables using XY type.
  9. ' 2nd Make snake brain and whole game only dependent sqrsX, sqrsY and sq for screen size
  10. ' Got it!!! the code ends with hangup head next to fruit with 99 (1 cell less that whole board)
  11. ' cells of snake length, no new place can be found for fruit, perfect finish and no duplicate
  12. ' cells! PLUS now can turn on a dime go up one colume and down the next in 2 key press.
  13. ' Now add autoPilot on -1 / off 0 toggle control, OK snake rules tested when human pilots snake.
  14. ' Help screen & independent speeds for human or AI.
  15. '2020-03-18  "Snake AI-1_4 fix tester" The AI tester needs to save Head(x, y) in case the AI
  16. ' does not change the head(x, y) or tries to move it diagonally.
  17.  
  18. '2020-03-18 Snake AI-1_5 SHARE change AS XY
  19. ' DIM SHARE change AS XY or change.x, change.y replaces variables called dx, dy.
  20. ' I decided to switch over to human control if AI fails to return a proper change.
  21. ' AI must leave change.x, change.y ready for human to take over control which means my changing
  22. ' the code for toggling the autopilot and adding change.x, change.y updates in my snakeBrain SUB.
  23. ' Rewrite SnakeBrain using only change.X and change.Y now. A BEEP will indicate an AI error and
  24. ' signal control returned to human. This noted in Key Help part of screen.
  25.  
  26. '################ MOD by Ashish ######################
  27. 'Added my own AI. It took 3 hours xD
  28.  
  29. '  Snakepit Dimensions: square size = sq, sqrsX = # of squares along x-axis and sqrsY squares down.
  30. CONST sq = 20, sqrsX = 20, sqrsY = 20, xmax = sq * sqrsX, ymax = sq * sqrsY
  31. SCREEN _NEWIMAGE(800, 600, 32)
  32. _DELAY .25
  33.  
  34. '##### snake brain related variables ######
  35. TYPE snake_memory_type
  36.     sn_l AS _BYTE
  37.     sn_r AS _BYTE
  38.     sn_t AS _BYTE
  39.     sn_b AS _BYTE
  40.  
  41.     fr_l AS _BYTE
  42.     fr_r AS _BYTE
  43.     fr_t AS _BYTE
  44.     fr_b AS _BYTE
  45.  
  46.     'j_l AS _BYTE
  47.     'j_r AS _BYTE
  48.     'j_t AS _BYTE
  49.     'j_b AS _BYTE
  50.     hx AS INTEGER
  51.     hy AS INTEGER
  52.  
  53.  
  54.     decision AS _BYTE
  55.  
  56. REDIM SHARED snakeMemory(1) AS snake_memory_type
  57. DIM takeDecision AS LONG
  58. '######################################################
  59.  
  60. ' Usually used to give a point on 2D board a single name that has an X dimension and a Y dimension.
  61. TYPE XY
  62.     X AS INTEGER
  63.     Y AS INTEGER
  64.  
  65. '   SHARED variables for any version of SnakeBrain SUB to act as autoPilot for snake snake.
  66. DIM SHARED change AS XY '                            directs the head direction through AI or Human
  67. DIM SHARED head AS XY '                           leads the way of the snake(body) through snakepit
  68. DIM SHARED sLen AS INTEGER '                                                        length of snake
  69. DIM SHARED snake(1 TO sqrsX * sqrsY) AS XY '                   whole snake, head is at index = sLen
  70. DIM SHARED fruit AS XY '     as snake eats fruit it grows, object is to grow snake to fill snakepit
  71.  
  72. '   SHARED for screenUpdate
  73. DIM SHARED pal(sqrsX * sqrsY) AS _UNSIGNED LONG '                                  for snake colors
  74. 'other data needed for program
  75. DIM autoPilot AS INTEGER, hSpeed, aSpeed, saveChange AS XY
  76.  
  77. help '                                                                                     Key Menu
  78. hSpeed = 3: aSpeed = 20 '                     autopilot speed is independent of human control speed
  79. aSpeed = 80 'so that it will learn faster
  80.  
  81. restart: '                                                                             reinitialize
  82. r = .3 + RND * .7: g = r * .5 + RND * .3 - .15: b = .5 * r + RND * .3 - .15 '    rnd pal color vars
  83. FOR i = 1 TO sqrsX * sqrsY '                               enough colors for snake to fill snakepit
  84.     pal(i) = _RGB32(84 + 64 * SIN(r + i / 2), 84 + 64 * SIN(g + i / 2), 104 * SIN(b + i / 2))
  85. head.X = sqrsX / 2 - 3: head.Y = sqrsY / 2 - 3 '                                         head start
  86. fruit.X = sqrsX / 2 + 2: fruit.Y = sqrsY / 2 + 2 '                                      first fruit
  87. sLen = 1 '                                                           for starters snake is all head
  88. snake(sLen).X = head.X: snake(sLen).Y = head.Y '                         head is always at sLen end
  89. autoPilot = 1 '                                                              start snake body count
  90. change.X = 0: change.Y = 1 '                      head snake down board, Y direction of first fruit
  91.     _TITLE STR$(sLen)
  92.     LINE (0, 0)-(xmax, ymax), &HFF884422, BF '                                       clear snakepit
  93.     IF sLen = sqrsX * sqrsY - 1 THEN screenUpdate: EXIT DO '             game is won! start another
  94.     KEY$ = INKEY$
  95.     IF KEY$ = "q" OR KEY$ = CHR$(27) THEN '                                            here is quit
  96.         END '
  97.     ELSEIF KEY$ = "a" THEN '                                                       toggle autoPilot
  98.         autoPilot = 1 - autoPilot '   it is now up to AI to keep change updated for human take over
  99.     ELSEIF KEY$ = "p" THEN '                               pause toggle p starts pause p ends pause
  100.         _KEYCLEAR: WHILE INKEY$ <> "p": _LIMIT 60: WEND
  101.     ELSEIF KEY$ = "s" THEN
  102.         IF autoPilot AND aSpeed + 5 < 400 THEN aSpeed = aSpeed + 5 ' max autopilot speed is 400 !!!
  103.         IF autoPilot = 0 AND hSpeed + .5 < 10 THEN hSpeed = hSpeed + .5 '     max human speed is 10
  104.     ELSEIF KEY$ = "-" THEN
  105.         IF autoPilot AND aSpeed - 5 > 0 THEN aSpeed = aSpeed - 5
  106.         IF autoPilot = 0 AND hSpeed - .5 > 1 THEN hSpeed = hSpeed - .5
  107.     END IF '                                                                                      '
  108.  
  109.     IF autoPilot THEN '                                                 who is piloting the snake?
  110.  
  111.         saveChange.X = change.X: saveChange.Y = change.Y '   if AI screws up then human takes over
  112.  
  113.         ' PLUG-IN YOUR Snake Brain AI here
  114.         '=========================================================================== AI Auto Pilot
  115.         takeDecision = snakeBrain
  116.         '=========================================================================================
  117.  
  118.         'check changes
  119.         IF ABS(change.X) = 0 THEN '                                      must have diffence in y's
  120.             IF ABS(change.Y) <> 1 THEN autoPilot = 0 '                       error switch to human
  121.         ELSEIF ABS(change.Y) = 0 THEN
  122.             IF ABS(change.X) <> 1 THEN autoPilot = 0 '                       error switch to human
  123.         ELSE '                           must have a 0 in either change.x or change.y but not both
  124.             autoPilot = 0 '                                                  error switch to human
  125.         END IF
  126.         '####################### Ashish AI related code #################################
  127.         'if there is an error, it will try to change its decision for later events
  128.         IF autoPilot = 0 THEN
  129.             IF snakeMemory(takeDecision).decision < 5 THEN snakeMemory(takeDecision).decision = snakeMemory(takeDecision).decision + 1 ELSE snakeMemory(takeDecision).decision = 0
  130.             _ECHO "new decision : " + STR$(snakeMemory(takeDecision).decision)
  131.         END IF
  132.         '#####################################################################################
  133.         IF autoPilot = 0 THEN '              switching control over to human restore change values
  134.             change.X = saveChange.X: change.Y = saveChange.Y: ' BEEP '                   alert human
  135.         END IF
  136.  
  137.     ELSE '  =======================================================================  human control
  138.         IF KEY$ = CHR$(0) + CHR$(72) THEN '                                               up arrow
  139.             change.X = 0: change.Y = -1
  140.         ELSEIF KEY$ = CHR$(0) + CHR$(80) THEN '                                         down arrow
  141.             change.X = 0: change.Y = 1
  142.         ELSEIF KEY$ = CHR$(0) + CHR$(77) THEN '                                        right arrow
  143.             change.X = 1: change.Y = 0
  144.         ELSEIF KEY$ = CHR$(0) + CHR$(75) THEN '                                         left arrow
  145.             change.X = -1: change.Y = 0
  146.         END IF
  147.         addExperience change
  148.     END IF
  149.     head.X = head.X + change.X: head.Y = head.Y + change.Y '            OK human or AI have spoken
  150.  
  151.     '   ============================  check snake head with Rules: ===============================
  152.  
  153.     ' 1. Snakepit boundary check, snake hits wall, dies.
  154.     IF head.X < 0 OR head.X > sqrsX - 1 OR head.Y < 0 OR head.Y > sqrsY - 1 THEN
  155.         _TITLE _TRIM$(STR$(sLen)) + " Wall Crash": screenUpdate
  156.         '#################################### Ashish AI related code #####################################
  157.         IF snakeMemory(takeDecision).decision < 5 THEN snakeMemory(takeDecision).decision = snakeMemory(takeDecision).decision + 1 ELSE snakeMemory(takeDecision).decision = 0
  158.         _ECHO "new decision : " + STR$(snakeMemory(takeDecision).decision)
  159.         '##################################################################################################
  160.         EXIT DO
  161.     END IF
  162.  
  163.     ' 2. Snake eats body part, dies. This should kill snake if turn its head back on itself.
  164.     FOR i = 1 TO sLen '                                              did head just crash into body?
  165.         IF head.X = snake(i).X AND head.Y = snake(i).Y THEN
  166.             _TITLE _TRIM$(STR$(sLen)) + " Body Crash": screenUpdate
  167.             '####################### Ashish AI related code ####################################################
  168.             'if there is an error, it will try to change its decision for later events
  169.             IF snakeMemory(takeDecision).decision < 5 THEN snakeMemory(takeDecision).decision = snakeMemory(takeDecision).decision + 1 ELSE snakeMemory(takeDecision).decision = 0
  170.             '####################################################################################################
  171.             EXIT DO '                 yes!
  172.         END IF
  173.     NEXT '                                                                                       no
  174.  
  175.     ' 3. Eats Fruit and grows or just move every segment up 1 space.
  176.     IF (fruit.X = head.X AND fruit.Y = head.Y) THEN '                              snake eats fruit
  177.         sLen = sLen + 1
  178.         snake(sLen).X = head.X: snake(sLen).Y = head.Y ' assimilate fruit into head for new segment
  179.         DO 'check new apple
  180.             fruit.X = INT(RND * sqrsX): fruit.Y = INT(RND * sqrsY): good = -1
  181.             FOR i = 1 TO sLen
  182.                 IF fruit.X = snake(i).X AND fruit.Y = snake(i).Y THEN good = 0: EXIT FOR
  183.             NEXT
  184.         LOOP UNTIL good
  185.     ELSE
  186.         FOR i = 1 TO sLen '                            move the snake data down 1 dropping off last
  187.             snake(i).X = snake(i + 1).X: snake(i).Y = snake(i + 1).Y
  188.         NEXT
  189.         snake(sLen).X = head.X: snake(sLen).Y = head.Y '               and adding new head position
  190.     END IF
  191.  
  192.     screenUpdate '                                                     on with the show this is it!
  193.     IF autoPilot THEN _LIMIT aSpeed ELSE _LIMIT hSpeed ' independent speed control for human and AI
  194. '_DELAY 3 '                                                                   win or loose, go again
  195. GOTO restart:
  196.  
  197. SUB screenUpdate ' draw snake and fruit, overlap code debugger
  198.     DIM c~&, i AS INTEGER, overlap(sqrsX, sqrsY) AS INTEGER
  199.     FOR i = 1 TO sLen
  200.         IF i = sLen THEN c~& = &HFF000000 ELSE c~& = pal(sLen - i)
  201.  
  202.         '                overlap helps debug duplicate square drawing which indicates a flawed code
  203.         overlap(snake(i).X, snake(i).Y) = overlap(snake(i).X, snake(i).Y) + 1
  204.  
  205.         LINE (snake(i).X * sq, snake(i).Y * sq)-STEP(sq - 2, sq - 2), c~&, BF
  206.         IF overlap(snake(i).X, snake(i).Y) > 1 THEN ' show visually where code flaws effect display
  207.             LINE (snake(i).X * sq + .25 * sq, snake(i).Y * sq + .25 * sq)_
  208.             -STEP(.5 * sq - 2, .5 * sq - 2), &HFFFFFFFF, BF
  209.         END IF
  210.     NEXT
  211.     LINE (fruit.X * sq, fruit.Y * sq)-STEP(sq - 2, sq - 2), _RGB32(255, 100, 255), BF
  212.     _DISPLAY
  213.  
  214. FUNCTION snakeBrain '>>>>>>>>>>   B+  SNAKE BRAIN  needs sqrsX to be even number  <<<<<<<<<<<<<<<
  215.  
  216.     'IF sqrsX MOD 2 = 1 THEN change.X = 0: change.Y = 0: EXIT SUB 'throw error for code check to
  217.     ''                                                      discover and switch to human control
  218.  
  219.     'IF head.X = 0 AND head.Y = sqrsY - 1 THEN
  220.     '    change.X = 0: change.Y = -1
  221.     'ELSEIF head.X MOD 2 = 0 AND head.Y <> 0 AND head.Y <> sqrsY - 1 THEN
  222.     '    change.X = 0: change.Y = -1
  223.     'ELSEIF head.X MOD 2 = 0 AND head.Y = 0 AND head.Y <> sqrsY - 1 THEN
  224.     '    change.X = 1: change.Y = 0
  225.     'ELSEIF head.X MOD 2 = 1 AND head.X <> sqrsX - 1 AND head.Y = sqrsY - 2 THEN
  226.     '    change.X = 1: change.Y = 0
  227.     'ELSEIF head.X MOD 2 = 1 AND head.X <> sqrsX - 1 AND head.Y < sqrsY - 1 THEN
  228.     '    change.X = 0: change.Y = 1
  229.     'ELSEIF head.X = sqrsX - 1 AND head.Y = sqrsY - 1 THEN
  230.     '    change.X = -1: change.Y = 0
  231.     'ELSEIF head.Y = sqrsY - 1 AND head.X <> 0 THEN
  232.     '    change.X = -1: change.Y = 0
  233.     'ELSEIF head.X MOD 2 = 1 AND head.Y = 0 AND head.Y <> sqrsY - 1 THEN
  234.     '    change.X = 0: change.Y = 1
  235.     'ELSEIF head.X = sqrsX - 1 AND head.Y < sqrsY - 1 THEN
  236.     '    change.X = 0: change.Y = 1
  237.     'END IF
  238.  
  239.     'Ashish AI 2, learn by its mistake.
  240.     DIM f_left, f_right, f_top, f_bottom
  241.     DIM sn_left, sn_right, sn_top, sn_bottom
  242.     ' DIM j_left, j_right, j_top, j_bottom
  243.     DIM decision, i AS LONG, n AS LONG, eventExists '0=not decided, 1=left, 2=right, 3=top, 4=bottom
  244.     STATIC preSLen, bestSLen, bioClock AS _UNSIGNED _INTEGER64
  245.  
  246.     IF preSLen = sLen THEN bioClock = bioClock + 1
  247.  
  248.  
  249.  
  250.     IF bestSLen < sLen THEN bestSLen = sLen
  251.  
  252.     IF fruit.X - head.X > 0 THEN f_right = 1 ELSE f_left = 1
  253.     IF fruit.Y - head.Y > 0 THEN f_bottom = 1 ELSE f_top = 1
  254.  
  255.     'IF fruit.X - head.X = -1 THEN j_left = 1
  256.     'IF fruit.X - head.X = 1 THEN j_right = 1
  257.     'IF fruit.Y - head.Y = -1 THEN j_top = 1
  258.     'IF fruit.Y - head.Y = 1 THEN j_bottom = 1
  259.  
  260.     sn_left = snakeBodyExists(1, -1)
  261.     sn_right = snakeBodyExists(1, 1)
  262.     sn_top = snakeBodyExists(2, -1)
  263.     sn_bottom = snakeBodyExists(2, 1)
  264.  
  265.     _ECHO "Total experiences(s) : " + STR$(UBOUND(snakeMemory) - 1) + ", Max Snake Length : " + STR$(bestSLen)
  266.     FOR i = 0 TO UBOUND(snakeMemory) - 1
  267.         'check if the current experiece exists in snake memory, so it can use that decision now.
  268.         if snakeMemory(i).sn_l = sn_left and snakeMemory(i).sn_r = sn_right and _
  269.         snakeMemory(i).sn_t = sn_top and snakeMemory(i).sn_b = sn_bottom and _
  270.         snakeMemory(i).fr_l = f_left and snakeMemory(i).fr_r = f_right and _
  271.         snakeMemory(i).fr_t = f_top and snakeMemory(i).fr_b = f_bottom  then
  272.             IF bioClock > 50 THEN
  273.                 IF snakeMemory(i).decision < 5 THEN snakeMemory(i).decision = snakeMemory(i).decision + 1 ELSE snakeMemory(i).decision = 0
  274.                 bioClock = 0
  275.             ELSE
  276.                 decision = snakeMemory(i).decision
  277.             END IF
  278.             snakeBrain = i
  279.             eventExists = 1
  280.         END IF
  281.     NEXT
  282.     IF eventExists = 0 THEN
  283.         'add new experiece to snake brain
  284.         n = UBOUND(snakeMemory)
  285.  
  286.         snakeMemory(n).sn_l = sn_left
  287.         snakeMemory(n).sn_r = sn_right
  288.         snakeMemory(n).sn_t = sn_top
  289.         snakeMemory(n).sn_b = sn_bottom
  290.  
  291.         snakeMemory(n).fr_l = f_left
  292.         snakeMemory(n).fr_r = f_right
  293.         snakeMemory(n).fr_t = f_top
  294.         snakeMemory(n).fr_b = f_bottom
  295.  
  296.         'snakeMemory(n).j_l = j_left
  297.         'snakeMemory(n).j_r = j_right
  298.         'snakeMemory(n).j_t = j_top
  299.         'snakeMemory(n).j_b = j_bottom
  300.         snakeMemory(n).hx = head.X
  301.         snakeMemory(n).hy = head.Y
  302.  
  303.         snakeMemory(n).decision = 0
  304.  
  305.         REDIM _PRESERVE snakeMemory(n + 1) AS snake_memory_type
  306.  
  307.         snakeBrain = n
  308.     END IF
  309.  
  310.     SELECT CASE decision
  311.         CASE 0
  312.             'things will be same
  313.         CASE 1
  314.             change.X = -1: change.Y = 0
  315.         CASE 2
  316.             change.X = 1: change.Y = 0
  317.         CASE 3
  318.             change.X = 0: change.Y = -1
  319.         CASE 4
  320.             change.X = 0: change.Y = 1
  321.     END SELECT
  322.  
  323.     preSLen = sLen
  324.  
  325. SUB addExperience (c AS XY)
  326.     DIM n AS LONG, d
  327.     DIM f_right, f_left, f_top, f_bottom, sn_right, sn_left, sn_top, sn_bottom, i
  328.  
  329.  
  330.     IF fruit.X - head.X > 0 THEN f_right = 1 ELSE f_left = 1
  331.     IF fruit.Y - head.Y > 0 THEN f_bottom = 1 ELSE f_top = 1
  332.  
  333.     'IF fruit.X - head.X = -1 THEN j_left = 1
  334.     'IF fruit.X - head.X = 1 THEN j_right = 1
  335.     'IF fruit.Y - head.Y = -1 THEN j_top = 1
  336.     'IF fruit.Y - head.Y = 1 THEN j_bottom = 1
  337.     IF c.X = 0 AND c.Y = 0 THEN d = 0
  338.     IF c.Y = 0 THEN
  339.         IF c.X = -1 THEN d = 1 ELSE d = 2
  340.     END IF
  341.     IF c.X = 0 THEN
  342.         IF c.Y = -1 THEN d = 3 ELSE d = 4
  343.     END IF
  344.  
  345.     sn_left = snakeBodyExists(1, -1)
  346.     sn_right = snakeBodyExists(1, 1)
  347.     sn_top = snakeBodyExists(2, -1)
  348.     sn_bottom = snakeBodyExists(2, 1)
  349.  
  350.  
  351.     FOR i = 0 TO UBOUND(snakeMemory) - 1
  352.         'check if the current experiece exists in snake memory, so it can use that decision now.
  353.         if snakeMemory(i).sn_l = sn_left and snakeMemory(i).sn_r = sn_right and _
  354.         snakeMemory(i).sn_t = sn_top and snakeMemory(i).sn_b = sn_bottom and _
  355.         snakeMemory(i).fr_l = f_left and snakeMemory(i).fr_r = f_right and _
  356.         snakeMemory(i).fr_t = f_top and snakeMemory(i).fr_b = f_bottom  then
  357.             snakeMemory(i).decision = d
  358.             EXIT SUB
  359.         END IF
  360.     NEXT
  361.  
  362.     'add new experiece to snake brain
  363.     n = UBOUND(snakeMemory)
  364.  
  365.     snakeMemory(n).sn_l = sn_left
  366.     snakeMemory(n).sn_r = sn_right
  367.     snakeMemory(n).sn_t = sn_top
  368.     snakeMemory(n).sn_b = sn_bottom
  369.  
  370.     snakeMemory(n).fr_l = f_left
  371.     snakeMemory(n).fr_r = f_right
  372.     snakeMemory(n).fr_t = f_top
  373.     snakeMemory(n).fr_b = f_bottom
  374.  
  375.     'snakeMemory(n).j_l = j_left
  376.     'snakeMemory(n).j_r = j_right
  377.     'snakeMemory(n).j_t = j_top
  378.     'snakeMemory(n).j_b = j_bottom
  379.     snakeMemory(n).hx = head.X
  380.     snakeMemory(n).hy = head.Y
  381.  
  382.     snakeMemory(i).decision = d
  383.  
  384.     REDIM _PRESERVE snakeMemory(n + 1) AS snake_memory_type
  385.  
  386.  
  387.  
  388. FUNCTION distFromBody (which%, direction%) 'which%: 1=x-axis, 2=y-axis, direction%:1 = right,bottom, -1=left,top
  389.     'return the min distance of snake body from its head in a given direction and axis.
  390.     IF sLen = 1 THEN EXIT FUNCTION
  391.     DIM n, tmp
  392.     tmp = 1000
  393.     FOR n = 1 TO sLen - 1
  394.         IF which% = 1 THEN
  395.             IF direction% = 1 THEN
  396.                 IF snake(n).Y = head.Y AND snake(n).X > head.X THEN
  397.                     IF (snake(n).X - head.X) < tmp THEN
  398.                         distFromBody = snake(n).X - head.X
  399.                         tmp = distFromBody
  400.                     END IF
  401.                 END IF
  402.             ELSE
  403.                 IF snake(n).Y = head.Y AND snake(n).X < head.X THEN
  404.                     IF (head.X - snake(n).X) < tmp THEN
  405.                         distFromBody = head.X - snake(n).X
  406.                         tmp = distFromBody
  407.                     END IF
  408.                 END IF
  409.             END IF
  410.         ELSE
  411.             IF direction% = 1 THEN
  412.                 IF snake(n).X = head.X AND snake(n).Y > head.Y THEN
  413.                     IF (snake(n).Y - head.Y) < tmp THEN
  414.                         distFromBody = snake(n).Y - head.Y
  415.                         tmp = distFromBody
  416.                     END IF
  417.                 END IF
  418.             ELSE
  419.                 IF snake(n).X = head.X AND snake(n).Y < head.Y THEN
  420.                     IF (head.Y - snake(n).Y) < tmp THEN
  421.                         distFromBody = head.Y - snake(n).Y
  422.                         tmp = distFromBody
  423.                     END IF
  424.                 END IF
  425.             END IF
  426.         END IF
  427.     NEXT
  428. FUNCTION snakeBodyExists (which%, direction%)
  429.     IF sLen = 1 THEN EXIT FUNCTION
  430.     DIM n
  431.     FOR n = 1 TO sLen - 1
  432.         IF which% = 1 THEN 'x-direction
  433.             IF direction% = 1 THEN
  434.                 IF snake(n).X - head.X > 0 AND snake(n).Y = head.Y THEN snakeBodyExists = 1: EXIT FUNCTION
  435.             ELSE
  436.                 IF snake(n).X - head.X < 0 AND snake(n).Y = head.Y THEN snakeBodyExists = 1: EXIT FUNCTION
  437.             END IF
  438.         ELSEIF which% = 2 THEN 'y-direction
  439.             IF direction% = 1 THEN
  440.                 IF snake(n).Y - head.Y > 0 AND snake(n).X = head.X THEN snakeBodyExists = 1: EXIT FUNCTION
  441.             ELSE
  442.                 IF snake(n).Y - head.Y < 0 AND snake(n).X = head.X THEN snakeBodyExists = 1: EXIT FUNCTION
  443.             END IF
  444.         END IF
  445.     NEXT
  446. SUB help
  447.     _PRINTSTRING (610, 20), "Keys:"
  448.     _PRINTSTRING (610, 40), "p toggles pause on/off"
  449.     _PRINTSTRING (610, 60), "a toggles autoPilot"
  450.     _PRINTSTRING (610, 100), "arrows control snake"
  451.     _PRINTSTRING (610, 80), "q or esc quits"
  452.     _PRINTSTRING (610, 120), "s increases speed"
  453.     _PRINTSTRING (610, 140), "- decreases speed"
  454.     _PRINTSTRING (610, 200), "A BEEP means AI error,"
  455.     _PRINTSTRING (610, 216), "human put in control."
  456.  

« Last Edit: March 24, 2020, 05:20:45 AM by Ashish »
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Online SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3486
    • Steve’s QB64 Archive Forum
Re: Smart Snake
« Reply #22 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!
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
Re: Smart Snake
« Reply #23 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.
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline bplus

  • Forum Resident
  • Posts: 7118
  • b = b + ...
Re: Smart Snake
« Reply #24 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]
  1. DEFINT A-Z
  2. _TITLE "Snake AI-1_8 Trail Blazer" 'b+ 2020-03-21 and Ashish SUB snakeBrainAshish1
  3.  
  4. '2020-03-14 Snake AI-1 first post
  5. '2020-03-16  Snake AI-1_1 there must be overlap of the snake somewhere! Aha!
  6. '2020-03-17 Snake AI-1_2 fix the duplicate segment problem
  7. ' Now a new mystery, an ocassional flashing duplicate box
  8. '2020-03-17 Install standard snake rules for testing brain evolving
  9. ' First setup XY type and rename and convert variables using XY type.
  10. ' 2nd Make snake brain and whole game only dependent sqrsX, sqrsY and sq for screen size
  11. ' Got it!!! the code ends with hangup head next to fruit with 99 (1 cell less that whole board)
  12. ' cells of snake length, no new place can be found for fruit, perfect finish and no duplicate
  13. ' cells! PLUS now can turn on a dime go up one colume and down the next in 2 key press.
  14. ' Now add autoPilot on -1 / off 0 toggle control, OK snake rules tested when human pilots snake.
  15. ' Help screen & independent speeds for human or AI.
  16. '2020-03-18  "Snake AI-1_4 fix tester" The AI tester needs to save Head(x, y) in case the AI
  17. ' does not change the head(x, y) or tries to move it diagonally.
  18. '2020-03-18 Snake AI-1_5 SHARE change AS XY
  19. ' DIM SHARE change AS XY or change.x, change.y replaces variables called dx, dy.
  20. ' I decided to switch over to human control if AI fails to return a proper change.
  21. ' AI must leave change.x, change.y ready for human to take over control which means my changing
  22. ' the code for toggling the autopilot and adding change.x, change.y updates in my snakeBrain SUB.
  23. ' Rewrite SnakeBrain using only change.X and change.Y now. A BEEP will indicate an AI error and
  24. ' signal control returned to human. This noted in Key Help part of screen.
  25. '2020-03-19 Snake AI-1_6 B+brain#2 begin a new snakeBrainBplus2 sub routine
  26. ' Add a driver report in title bar along with sLen.
  27. ' Oh hey what a fancy snake dance, not the least bit faster than snakeBrainBplus1.
  28. '2020-03-20 Snake AI-1_7 real AI
  29. ' RE: snakeBrainBplus2
  30. ' Recode snakeBrainBplus2 to be self contained in one SUB, load data for the array it uses inside
  31. ' that SUB. It also has to check sqrsX, sqrsY to be sure they are correct, this is pure novelty
  32. ' SUB so will set sqrsX, sqrsY back to 20 each for standard game AI setting. OK good!
  33. ' RE: sqrsX, sqrsY
  34. ' sqrsX, sqrsY reset back to 20, 20 for standard setup for testing AI.
  35. ' RE: Ashish first "real AI" very excellent submission!
  36. ' Attempt to incorporate Ashish "real AI" as SUB snakeBrainAshish1
  37. ' Ashish is using $CONSOLE and DIM SHARED state$ but I don't see why so I made state$ STATIC in
  38. ' his SUB and took console out, though I can see it might be needed later. Working here yeah!
  39. ' RE: SnakeBrainBplus3, bplus first "real AI" also working pretty well to a point.
  40. ' SnakeBrainBplus3 uses real AI and crashes when snake can't get to fruit due to it's length
  41. ' either by inaccessible fruit, snakes body blocks head or head buried in body and can't escape.
  42. ' Using lessons learned from Pathfinder work.
  43.  
  44. '2020-03-21 Snake AI-1_8 Trail Blazer
  45. ' As described at forum today, entice snake to safely coil itself before going after fruit at
  46. ' each increase of it's length. Does't look like this will work out.
  47. ' 3-22 try trailblazer sqaure attack pattern
  48.  
  49. ' Snakepit Dimensions: square size = sq, sqrsX = # of squares along x-axis and sqrsY squares down.
  50. CONST sq = 20, sqrsX = 20, sqrsY = 20, xmax = sq * sqrsX, ymax = sq * sqrsY
  51. SCREEN _NEWIMAGE(800, 600, 32)
  52. _DELAY .25
  53.  
  54. 'Usually used to give a point on 2D board a single name that has an X dimension and a Y dimension.
  55. TYPE XY
  56.     X AS INTEGER
  57.     Y AS INTEGER
  58.  
  59. '   SHARED variables for any version of SnakeBrain SUB to act as autoPilot for snake snake.
  60. DIM SHARED change AS XY '                           directs the head direction through AI or Human
  61. DIM SHARED head AS XY '                          leads the way of the snake(body) through snakepit
  62. DIM SHARED sLen '                                                                  length of snake
  63. DIM SHARED snake(1 TO sqrsX * sqrsY) AS XY '                  whole snake, head is at index = sLen
  64. DIM SHARED fruit AS XY '    as snake eats fruit it grows, object is to grow snake to fill snakepit
  65.  
  66. DIM SHARED yHeadLimit
  67.  
  68. '   SHARED for screenUpdate
  69. DIM SHARED pal(sqrsX * sqrsY) AS _UNSIGNED LONG '                                 for snake colors
  70.  
  71. 'other data needed for program
  72. DIM i, good, KEY$, r AS SINGLE, g AS SINGLE, b AS SINGLE
  73. DIM autoPilot, hSpeed AS SINGLE, aSpeed AS SINGLE, saveChange AS XY, title$
  74.  
  75. help '                                                                                    Key Menu
  76. hSpeed = 3: aSpeed = 20 '                    autopilot speed is independent of human control speed
  77.  
  78. restart: '                                                                            reinitialize
  79. r = .3 + RND * .7: g = r * .5 + RND * .3 - .15: b = .5 * r + RND * .3 - .15 '   rnd pal color vars
  80. FOR i = 1 TO sqrsX * sqrsY '                              enough colors for snake to fill snakepit
  81.     pal(i) = _RGB32(84 + 64 * SIN(r + i / 2), 84 + 64 * SIN(g + i / 2), 104 * SIN(b + i / 2))
  82. head.X = sqrsX / 2 - 3: head.Y = sqrsY / 2 - 3 '                                        head start
  83. fruit.X = sqrsX - 1: fruit.Y = sqrsY - 1
  84. 'fruit.X = sqrsX / 2 + 2: fruit.Y = sqrsY / 2 + 2 '                                     first fruit
  85. sLen = 1 '                                                          for starters snake is all head
  86. snake(sLen).X = head.X: snake(sLen).Y = head.Y '                        head is always at sLen end
  87. autoPilot = 1 '                                                             start snake body count
  88. change.X = 0: change.Y = 1 '                     head snake down board, Y direction of first fruit
  89.     IF autoPilot THEN title$ = "AI." ELSE title$ = "human."
  90.     _TITLE STR$(sLen) + " Current driver is " + title$
  91.     LINE (0, 0)-(xmax, ymax), &HFF884422, BF '                                      clear snakepit
  92.     IF sLen = sqrsX * sqrsY - 1 THEN screenUpdate: EXIT DO '            game is won! start another
  93.     KEY$ = INKEY$
  94.     IF KEY$ = "q" OR KEY$ = CHR$(27) THEN '                                           here is quit
  95.         END '
  96.     ELSEIF KEY$ = "a" THEN '                                                      toggle autoPilot
  97.         autoPilot = 1 - autoPilot '  it is now up to AI to keep change updated for human take over
  98.     ELSEIF KEY$ = "p" THEN '                              pause toggle p starts pause p ends pause
  99.         _KEYCLEAR: WHILE INKEY$ <> "p": _LIMIT 60: WEND
  100.     ELSEIF KEY$ = "s" THEN
  101.         IF autoPilot AND aSpeed + 5 < 400 THEN aSpeed = aSpeed + 5 'max autopilot speed is 400 !!!
  102.         IF autoPilot = 0 AND hSpeed + .5 < 10 THEN hSpeed = hSpeed + .5 '    max human speed is 10
  103.     ELSEIF KEY$ = "-" THEN
  104.         IF autoPilot AND aSpeed - 5 > 0 THEN aSpeed = aSpeed - 5
  105.         IF autoPilot = 0 AND hSpeed - .5 > 1 THEN hSpeed = hSpeed - .5
  106.     END IF '                                                                                      '
  107.  
  108.     IF autoPilot THEN '                                                 who is piloting the snake?
  109.  
  110.         saveChange.X = change.X: saveChange.Y = change.Y '   if AI screws up then human takes over
  111.  
  112.         ' PLUG-IN YOUR Snake Brain AI here
  113.         '=========================================================================== AI Auto Pilot
  114.         'snakeBrainBplus1 '        dumb track AI but always gets it's fruit! requires even # sqrsX
  115.         'snakeBrainBplus2 '    dumb track AI but looks cool! requirescustom sqrsX = 17, sqrsY = 16
  116.         'snakeBrainAshish1 '     first "realAI" I would call an heuristic approach, thanks Ashish!
  117.         'snakeBrainBplus3 '                 bplus "first real AI" uses modified Pathfinder methods
  118.  
  119.         snakeBrainBplus4
  120.         '=========================================================================================
  121.  
  122.         'check changes
  123.         IF ABS(change.X) = 0 THEN '                                      must have diffence in y's
  124.             IF ABS(change.Y) <> 1 THEN autoPilot = 0 '                       error switch to human
  125.         ELSEIF ABS(change.Y) = 0 THEN
  126.             IF ABS(change.X) <> 1 THEN autoPilot = 0 '                       error switch to human
  127.         ELSE '                           must have a 0 in either change.x or change.y but not both
  128.             autoPilot = 0 '                                                  error switch to human
  129.         END IF
  130.         IF autoPilot = 0 THEN '              switching control over to human restore change values
  131.             change.X = saveChange.X: change.Y = saveChange.Y: BEEP '                   alert human
  132.         END IF
  133.  
  134.     ELSE '  =======================================================================  human control
  135.         IF KEY$ = CHR$(0) + CHR$(72) THEN '                                               up arrow
  136.             change.X = 0: change.Y = -1
  137.         ELSEIF KEY$ = CHR$(0) + CHR$(80) THEN '                                         down arrow
  138.             change.X = 0: change.Y = 1
  139.         ELSEIF KEY$ = CHR$(0) + CHR$(77) THEN '                                        right arrow
  140.             change.X = 1: change.Y = 0
  141.         ELSEIF KEY$ = CHR$(0) + CHR$(75) THEN '                                         left arrow
  142.             change.X = -1: change.Y = 0
  143.         END IF
  144.  
  145.     END IF
  146.     head.X = head.X + change.X: head.Y = head.Y + change.Y '            OK human or AI have spoken
  147.  
  148.     '   ============================  check snake head with Rules: ===============================
  149.  
  150.     ' 1. Snakepit boundary check, snake hits wall, dies.
  151.     IF head.X < 0 OR head.X > sqrsX - 1 OR head.Y < 0 OR head.Y > sqrsY - 1 THEN
  152.         _TITLE _TRIM$(STR$(sLen)) + " Wall Crash": screenUpdate: EXIT DO '    wall crash, new game
  153.     END IF
  154.  
  155.     ' 2. Snake eats body part, dies. This should kill snake if turn its head back on itself.
  156.     FOR i = 1 TO sLen '                                             did head just crash into body?
  157.         IF head.X = snake(i).X AND head.Y = snake(i).Y THEN
  158.             _TITLE _TRIM$(STR$(sLen)) + " Body Crash": screenUpdate: EXIT DO ' yes! start new game
  159.         END IF
  160.     NEXT '                                                                                      no
  161.  
  162.     ' 3. Eats Fruit and grows or just move every segment up 1 space.
  163.     IF (fruit.X = head.X AND fruit.Y = head.Y) THEN '                             snake eats fruit
  164.         sLen = sLen + 1
  165.         snake(sLen).X = head.X: snake(sLen).Y = head.Y 'assimilate fruit into head for new segment
  166.         DO 'check new apple
  167.             fruit.X = INT(RND * sqrsX): fruit.Y = INT(RND * sqrsY): good = -1
  168.             FOR i = 1 TO sLen
  169.                 IF fruit.X = snake(i).X AND fruit.Y = snake(i).Y THEN good = 0: EXIT FOR
  170.             NEXT
  171.         LOOP UNTIL good
  172.     ELSE
  173.         FOR i = 1 TO sLen '                           move the snake data down 1 dropping off last
  174.             snake(i).X = snake(i + 1).X: snake(i).Y = snake(i + 1).Y
  175.         NEXT
  176.         snake(sLen).X = head.X: snake(sLen).Y = head.Y '              and adding new head position
  177.     END IF
  178.  
  179.     screenUpdate '                                                    on with the show this is it!
  180.     IF autoPilot THEN _LIMIT aSpeed ELSE _LIMIT hSpeed 'independent speed control for human and AI
  181. _DELAY 4 '                                                                  win or loose, go again
  182. GOTO restart:
  183.  
  184. SUB screenUpdate ' draw snake and fruit, overlap code debugger
  185.     DIM c~&, i, overlap(sqrsX, sqrsY)
  186.     FOR i = 1 TO sLen
  187.         IF i = sLen THEN c~& = &HFF000000 ELSE c~& = pal(sLen - i)
  188.  
  189.         '               overlap helps debug duplicate square drawing which indicates a flawed code
  190.         overlap(snake(i).X, snake(i).Y) = overlap(snake(i).X, snake(i).Y) + 1
  191.  
  192.         LINE (snake(i).X * sq, snake(i).Y * sq)-STEP(sq - 2, sq - 2), c~&, BF
  193.         IF overlap(snake(i).X, snake(i).Y) > 1 THEN 'show visually where code flaws effect display
  194.             LINE (snake(i).X * sq + .25 * sq, snake(i).Y * sq + .25 * sq)_
  195.             -STEP(.5 * sq - 2, .5 * sq - 2), &HFFFFFFFF, BF
  196.         END IF
  197.     NEXT
  198.     LINE (fruit.X * sq, fruit.Y * sq)-STEP(sq - 2, sq - 2), _RGB32(255, 100, 255), BF
  199.  
  200.     'bplus using for test of brain 4
  201.     LINE (0, yHeadLimit * sq)-(xmax, ymax), &H11FFFFFF, BF
  202.  
  203.     _DISPLAY
  204.  
  205. SUB help
  206.     _PRINTSTRING (610, 20), "Keys:"
  207.     _PRINTSTRING (610, 40), "p toggles pause on/off"
  208.     _PRINTSTRING (610, 60), "a toggles autoPilot"
  209.     _PRINTSTRING (610, 100), "arrows control snake"
  210.     _PRINTSTRING (610, 80), "q or esc quits"
  211.     _PRINTSTRING (610, 120), "s increases speed"
  212.     _PRINTSTRING (610, 140), "- decreases speed"
  213.     _PRINTSTRING (610, 200), "A BEEP means AI error,"
  214.     _PRINTSTRING (610, 216), "human put in control."
  215.  
  216. 'basic functions added for snakeBrainBplus3 (bplus first real AI)
  217. FUNCTION max (n, m)
  218.     IF n > m THEN max = n ELSE max = m
  219.  
  220. FUNCTION min (n, m)
  221.     IF n < m THEN min = n ELSE min = m
  222.  
  223. ' ================================================================= end code that runs Snake Games
  224.  
  225. SUB snakeBrainBplus1 '>>>>>>>>>>   B+  SNAKE BRAIN  needs sqrsX to be even number  <<<<<<<<<<<<<<<
  226.     ' This will be handy for standard 20x20 snakepit to dove tail real AI towrds.
  227.     'todo fix this so that when takeover control won't crash into self
  228.  
  229.     IF sqrsX MOD 2 = 1 THEN change.X = 0: change.Y = 0: EXIT SUB '   throw error for code check to
  230.     '                                                         discover and switch to human control
  231.  
  232.     IF head.X = 0 AND head.Y = sqrsY - 1 THEN
  233.         change.X = 0: change.Y = -1
  234.     ELSEIF head.X MOD 2 = 0 AND head.Y <> 0 AND head.Y <> sqrsY - 1 THEN
  235.         change.X = 0: change.Y = -1
  236.     ELSEIF head.X MOD 2 = 0 AND head.Y = 0 AND head.Y <> sqrsY - 1 THEN
  237.         change.X = 1: change.Y = 0
  238.     ELSEIF head.X MOD 2 = 1 AND head.X <> sqrsX - 1 AND head.Y = sqrsY - 2 THEN
  239.         change.X = 1: change.Y = 0
  240.     ELSEIF head.X MOD 2 = 1 AND head.X <> sqrsX - 1 AND head.Y < sqrsY - 1 THEN
  241.         change.X = 0: change.Y = 1
  242.     ELSEIF head.X = sqrsX - 1 AND head.Y = sqrsY - 1 THEN
  243.         change.X = -1: change.Y = 0
  244.     ELSEIF head.Y = sqrsY - 1 AND head.X <> 0 THEN
  245.         change.X = -1: change.Y = 0
  246.     ELSEIF head.X MOD 2 = 1 AND head.Y = 0 AND head.Y <> sqrsY - 1 THEN
  247.         change.X = 0: change.Y = 1
  248.     ELSEIF head.X = sqrsX - 1 AND head.Y < sqrsY - 1 THEN
  249.         change.X = 0: change.Y = 1
  250.     END IF
  251.  
  252. SUB snakeBrainBplus2 '   Needs custom sqrsX = 17, sqrsY = 16 This is mainly a novelty SUB for fun!
  253.     'A good AI will NOT require a custom sqrsX = 17, sqrsY = 16
  254.     IF sqrsX <> 17 OR sqrsY <> 16 THEN change.X = 0: change.Y = 0: EXIT SUB ' throw error for code
  255.     '                                                check to discover and switch to human control
  256.  
  257.     DIM x, y, s$, direction$
  258.     STATIC brain2Directions(sqrsX - 1, sqrsY - 1) AS STRING
  259.  
  260.     IF brain2Directions(0, 0) <> "R" THEN GOSUB loadBrain2Directions 'array not loaded yet so load
  261.     direction$ = brain2Directions(head.X, head.Y)
  262.     SELECT CASE direction$
  263.         CASE "U": change.X = 0: change.Y = -1
  264.         CASE "D": change.X = 0: change.Y = 1
  265.         CASE "L": change.X = -1: change.Y = 0
  266.         CASE "R": change.X = 1: change.Y = 0
  267.     END SELECT
  268.     EXIT SUB
  269.     loadBrain2Directions:
  270.     FOR y = 0 TO sqrsY - 1
  271.         READ s$
  272.         FOR x = 0 TO sqrsX - 1
  273.             brain2Directions(x, y) = MID$(s$, x + 1, 1)
  274.         NEXT
  275.     NEXT
  276.     RETURN
  277.  
  278.     DATA RRRRRRRRRRRRRRRRD
  279.     DATA UDLLLLLLLLLLLLLLD
  280.     DATA UDRRRRRRRRRRRRDUD
  281.     DATA UDUDLLLLLLLLLLDUD
  282.     DATA UDUDRRRRRRRRDUDUD
  283.     DATA UDUDUDLLLLLLDUDUD
  284.     DATA UDUDUDRRRRDUDUDUD
  285.     DATA UDUDUDUDLLDUDUDUD
  286.     DATA UDUDUDUDRUDUDUDUD
  287.     DATA UDUDUDUDULLUDUDUD
  288.     DATA UDUDUDURRRRUDUDUD
  289.     DATA UDUDUDULLLLLLUDUD
  290.     DATA UDUDURRRRRRRRUDUD
  291.     DATA UDUDULLLLLLLLLLUD
  292.     DATA UDURRRRRRRRRRRRUD
  293.     DATA ULULLLLLLLLLLLLLL
  294.  
  295.     '        note: I had the following lines in main code delares section in case OPTION _EXPLICIT
  296.     ' started alerts about DIM the STATIC variable in main but not needed.
  297.     '
  298.     '   I think OPTION _EXPLICIT requires next line but will make snakeBrainBplus2 self contained.
  299.     'DIM SHARED brain2Directions(0 TO sqrsX - 1, 0 TO sqrsY - 1) AS STRING ' 4 snakeBrainBplus2 AI
  300.  
  301.  
  302. SUB snakeBrainAshish1 'needs supplemental  FUNCTION snakeBodyExists (which%)
  303.     DIM nx, ny, dx, dy 'Ashish AI
  304.     STATIC decided
  305.     STATIC state$ '    bplus added state$ to SUB here and removed from DIM SHARED in Main Declares
  306.     dx = fruit.X - head.X
  307.     dy = fruit.Y - head.Y
  308.     nx = snakeBodyExists(1)
  309.     ny = snakeBodyExists(2)
  310.     IF sLen > 1 THEN 'collison at corners of square
  311.         IF head.X = 0 AND head.Y = 0 THEN
  312.             state$ = "corners"
  313.             IF change.X = -1 THEN change.X = 0: change.Y = 1: decided = 0: EXIT SUB
  314.             IF change.Y = -1 THEN change.Y = 0: change.X = 1: decided = 0: EXIT SUB
  315.         ELSEIF head.X = 0 AND head.Y = sqrsY - 1 THEN
  316.             state$ = "corners"
  317.             IF change.X = -1 THEN change.X = 0: change.Y = -1: decided = 0: EXIT SUB
  318.             IF change.Y = 1 THEN change.Y = 0: change.X = 1: decided = 0: decided = 0: EXIT SUB
  319.         ELSEIF head.X = sqrsX - 1 AND head.Y = 0 THEN
  320.             state$ = "corners"
  321.             IF change.X = 1 THEN change.X = 0: change.Y = 1: decided = 0: EXIT SUB
  322.             IF change.Y = -1 THEN change.Y = 0: change.X = -1: decided = 0: EXIT SUB
  323.         ELSEIF head.X = sqrsX - 1 AND head.Y = sqrsY - 1 THEN
  324.             state$ = "corners"
  325.             IF change.X = 1 THEN change.X = 0: change.Y = -1: decided = 0: EXIT SUB
  326.             IF change.Y = 1 THEN change.Y = 0: change.X = -1: decided = 0: EXIT SUB
  327.         END IF
  328.         IF decided = 0 THEN 'collision with walls
  329.             IF head.X = sqrsX - 1 OR head.X = 0 THEN
  330.                 state$ = "walls"
  331.                 IF ny = 0 THEN
  332.                     IF dy > 0 THEN ny = -1 ELSE ny = 1
  333.                 END IF
  334.                 change.Y = ny * -1: change.X = 0
  335.                 decided = 1
  336.                 EXIT SUB
  337.             ELSEIF head.Y = sqrsY - 1 OR head.Y = 0 THEN
  338.                 state$ = "walls"
  339.                 IF nx = 0 THEN
  340.                     IF dx > 0 THEN nx = -1 ELSE nx = 1
  341.                 END IF
  342.                 change.X = nx * -1: change.Y = 0
  343.                 decided = 1
  344.                 EXIT SUB
  345.             END IF
  346.         END IF
  347.     END IF
  348.     IF dx = 0 THEN 'when fruit and head in same direction and motion in same axis
  349.         IF change.Y = 0 THEN
  350.             state$ = "linear"
  351.             IF dy > 0 AND ny <> 1 THEN
  352.                 change.Y = 1: change.X = 0: decided = 0: EXIT SUB
  353.             ELSEIF dy < 0 AND ny <> -1 THEN
  354.                 change.Y = -1: change.X = 0: decided = 0: EXIT SUB
  355.             END IF
  356.         END IF
  357.     END IF
  358.     IF dy = 0 THEN
  359.         IF change.X = 0 THEN
  360.             state$ = "linear"
  361.             IF dx > 0 AND nx <> 1 THEN
  362.                 change.X = 1: change.Y = 0: decided = 0: EXIT SUB
  363.             ELSEIF dx < 0 AND nx <> -1 THEN
  364.                 change.X = -1: change.Y = 0: decided = 0: EXIT SUB
  365.             END IF
  366.         END IF
  367.     END IF
  368.  
  369.     state$ = "common"
  370.     'common decision
  371.     IF ABS(dx) < ABS(dy) THEN
  372.         state$ = "common ny=" + STR$(ny)
  373.         IF ny = 0 THEN
  374.             change.X = 0
  375.             IF dy > 0 THEN change.Y = 1 ELSE change.Y = -1
  376.             state$ = "common cy=" + STR$(change.Y)
  377.             EXIT SUB
  378.         END IF
  379.         IF dy > 0 AND ny <> 1 THEN change.Y = 1: change.X = 0
  380.         IF dy < 0 AND ny <> -1 THEN change.Y = -1: change.X = 0
  381.         decided = 0
  382.     ELSE
  383.         state$ = "common nx=" + STR$(nx)
  384.         IF nx = 0 THEN
  385.             change.Y = 0
  386.             IF dx > 0 THEN change.X = 1 ELSE change.X = -1
  387.             state$ = "common cx=" + STR$(change.X)
  388.             EXIT SUB
  389.         END IF
  390.         IF dx > 0 AND nx <> 1 THEN change.X = 1: change.Y = 0
  391.         IF dx < 0 AND nx <> -1 THEN change.X = -1: change.Y = 0
  392.         decided = 0
  393.     END IF
  394.  
  395.     state$ = "rand_common"
  396.     IF ABS(dx) = ABS(dy) THEN 'random choice will be made then, rest code is same as above
  397.         IF RND > 0.5 THEN
  398.             state$ = "rand_common ny=" + STR$(ny)
  399.             IF ny = 0 THEN
  400.                 change.X = 0
  401.                 IF dy > 0 THEN change.Y = 1 ELSE change.Y = -1
  402.                 state$ = "rand_common cy=" + STR$(change.Y)
  403.                 EXIT SUB
  404.             END IF
  405.             IF dy > 0 AND ny <> 1 THEN change.Y = 1: change.X = 0
  406.             IF dy < 0 AND ny <> -1 THEN change.Y = -1: change.X = 0
  407.             decided = 0
  408.         ELSE
  409.             state$ = "rand_common nx=" + STR$(nx)
  410.             IF nx = 0 THEN
  411.                 change.Y = 0
  412.                 IF dx > 0 THEN change.X = 1 ELSE change.X = -1
  413.                 state$ = "rand_common cx=" + STR$(change.X)
  414.                 EXIT SUB
  415.             END IF
  416.             IF dx > 0 AND nx <> 1 THEN change.X = 1: change.Y = 0
  417.             IF dx < 0 AND nx <> -1 THEN change.X = -1: change.Y = 0
  418.             decided = 0
  419.         END IF
  420.     END IF
  421.  
  422. FUNCTION snakeBodyExists (which%) ' for SUB snakeBrainAshish1 supplemental
  423.     IF sLen = 1 THEN EXIT FUNCTION
  424.     DIM n
  425.     FOR n = 1 TO sLen - 1
  426.         IF which% = 1 THEN 'x-direction
  427.             IF snake(n).X - head.X > 0 AND snake(n).Y = head.Y THEN snakeBodyExists = 1: EXIT FUNCTION
  428.             IF snake(n).X - head.X < 0 AND snake(n).Y = head.Y THEN snakeBodyExists = -1: EXIT FUNCTION
  429.         ELSEIF which% = 2 THEN 'y-direction
  430.             IF snake(n).Y - head.Y > 0 AND snake(n).X = head.X THEN snakeBodyExists = 1: EXIT FUNCTION
  431.             IF snake(n).Y - head.Y < 0 AND snake(n).X = head.X THEN snakeBodyExists = -1: EXIT FUNCTION
  432.         END IF
  433.     NEXT
  434.  
  435. SUB snakeBrainBplus3 ' real AI, responds to real time information
  436.  
  437.     'needs FUNCTION max (n , m ),   FUNCTION min (n , m )
  438.  
  439.     'from: Pathfinder inside Maze.bas B+ 2019-12-19 only completely overhauled!
  440.     DIM x, y, i, changeF
  441.     DIM parentF, tick, foundHead, headMarked
  442.     DIM yStart, yStop, xStart, xStop
  443.     DIM map(sqrsX - 1, sqrsY - 1) AS STRING, map2(sqrsX - 1, sqrsY - 1) AS STRING
  444.     FOR y = 0 TO sqrsY - 1
  445.         FOR x = 0 TO sqrsX - 1
  446.             map(x, y) = " "
  447.         NEXT
  448.     NEXT
  449.     FOR i = 1 TO sLen - 1 ' draw snake in map
  450.         map(snake(i).X, snake(i).Y) = "S"
  451.     NEXT
  452.     map(head.X, head.Y) = "H"
  453.     map(fruit.X, fruit.Y) = "F"
  454.     tick = 0
  455.     WHILE parentF OR headMarked = 0
  456.         parentF = 0: tick = tick + 1
  457.         yStart = max(fruit.Y - tick, 0): yStop = min(fruit.Y + tick, sqrsY - 1)
  458.         REDIM map2(sqrsX - 1, sqrsY - 1) AS STRING '    need a 2nd map to hold all new stuff until
  459.         FOR y = 0 TO sqrsY - 1 '                                          the entire square coverd
  460.             FOR x = 0 TO sqrsX - 1
  461.                 map2(x, y) = " "
  462.             NEXT
  463.         NEXT
  464.         FOR y = yStart TO yStop
  465.             xStart = max(fruit.X - tick, 0): xStop = min(fruit.X + tick, sqrsX - 1)
  466.             FOR x = xStart TO xStop
  467.                 'check out the neighbors
  468.                 IF map(x, y) = " " OR map(x, y) = "H" THEN
  469.                     IF map(x, y) = "H" THEN foundHead = -1
  470.                     IF y - 1 >= 0 THEN
  471.                         IF INSTR("UDLRF", map(x, y - 1)) THEN
  472.                             map2(x, y) = "U": parentF = 1
  473.                             IF foundHead THEN headMarked = -1
  474.                         END IF
  475.                     END IF
  476.                     IF y + 1 <= sqrsY - 1 THEN
  477.                         IF INSTR("UDLRF", map(x, y + 1)) THEN
  478.                             map2(x, y) = "D": parentF = 1
  479.                             IF foundHead THEN headMarked = -1
  480.                         END IF
  481.                     END IF
  482.                     IF x + 1 <= sqrsX - 1 THEN
  483.                         IF INSTR("UDLRF", map(x + 1, y)) THEN
  484.                             map2(x, y) = "R": parentF = 1
  485.                             IF foundHead THEN headMarked = -1
  486.                         END IF
  487.                     END IF
  488.                     IF x - 1 >= 0 THEN
  489.                         IF INSTR("UDLRF", map(x - 1, y)) THEN
  490.                             map2(x, y) = "L": parentF = 1
  491.                             IF foundHead THEN headMarked = -1
  492.                         END IF
  493.                     END IF
  494.                 END IF
  495.             NEXT
  496.         NEXT
  497.         FOR y = 0 TO sqrsY - 1 'transfer data to map
  498.             FOR x = 0 TO sqrsX - 1
  499.                 IF map2(x, y) <> " " THEN map(x, y) = map2(x, y): changeF = 1
  500.             NEXT
  501.         NEXT
  502.     WEND 'if no ParentF then dead connection to Fruit
  503.     SELECT CASE map(head.X, head.Y)
  504.         CASE "H" ' cause crash because no connection to fruit found
  505.             IF change.X THEN change.X = -change.X ELSE change.Y = -change.Y 'make Body crash
  506.             ' change.X = 0: change.Y = 0 '   this will switch auto control off to avoid program hang, dang still hangs!
  507.         CASE "D": change.X = 0: change.Y = 1
  508.         CASE "U": change.X = 0: change.Y = -1
  509.         CASE "R": change.X = 1: change.Y = 0
  510.         CASE "L": change.X = -1: change.Y = 0
  511.     END SELECT
  512.  
  513. 'SUB snakeBrainBplus 4 ' fake fruit test responds to real time information
  514.  
  515. '    'needs FUNCTION max (n , m ),   FUNCTION min (n , m )
  516.  
  517. '    'from: Pathfinder inside Maze.bas B+ 2019-12-19 only completely overhauled!
  518. '    DIM x, y, i, changeF
  519. '    DIM parentF, tick, foundHead, headMarked
  520. '    DIM yStart, yStop, xStart, xStop
  521. '    DIM map(sqrsX - 1, sqrsY - 1) AS STRING, map2(sqrsX - 1, sqrsY - 1) AS STRING
  522.  
  523. '    'fake fruit variables
  524. '    STATIC lastSLen, goals(1 TO 40) AS XY, topGoal
  525.  
  526.  
  527. '    FOR y = 0 TO sqrsY - 1
  528. '        FOR x = 0 TO sqrsX - 1
  529. '            map(x, y) = " "
  530. '        NEXT
  531. '    NEXT
  532. '    FOR i = 1 TO sLen - 1 ' draw snake in map
  533. '        map(snake(i).X, snake(i).Y) = "S"
  534. '    NEXT
  535. '    map(head.X, head.Y) = "H"
  536.  
  537. '    'fake fruit  before releaseing snake to persue real fruit, we setup some fale fruit goals
  538. '    'to persue first in order to safely coil the snake so it's doesn't entangle itself and
  539. '    ' choke itelf of access to fruit
  540. '    IF sLen > lastSLen THEN
  541. '        'make goals list  if hasn't been made yet
  542. '        IF goals(2).Y <> sqrsY - 1 THEN
  543. '            goals(1).X = 0: goals(1).Y = 0
  544. '            goals(2).X = 0: goals(2).Y = sqrsY - 1
  545. '            goals(3).X = sqrsX - 1: goals(3).Y = sqrsY - 1
  546. '            i = 4
  547. '            WHILE i + 1 < sqrsY * 2
  548. '                goals(i).X = sqrsX - 1: goals(i).Y = goals(i - 1).Y - 1
  549. '                goals(i + 1).X = 1: goals(i + 1).Y = goals(i).Y
  550. '                goals(i + 2).X = 1: goals(i + 2).Y = goals(i).Y - 1
  551. '                goals(i + 3).X = sqrsX - 1: goals(i + 3).Y = goals(i + 2).Y
  552. '                i = i + 4
  553. '            WEND
  554. '        END IF 'list not made yet
  555. '        topGoal = sLen \ 20 'set new goal
  556. '        lastSLen = sLen 'reset checker
  557. '    END IF
  558. '    IF topGoal THEN
  559. '        IF head.X = goals(topGoal).X AND head.Y = goals(topGoal).Y THEN topGoal = topGoal - 1
  560. '        IF topGoal THEN map(goals(topGoal).X, goals(topGoal).Y) = "F" ELSE map(fruit.X, fruit.Y) = "F"
  561. '    ELSE
  562. '        map(fruit.X, fruit.Y) = "F"
  563. '    END IF
  564. '    'ok false fruit or fruit target set for pathfinder
  565.  
  566. '    tick = 0
  567. '    WHILE parentF OR headMarked = 0
  568. '        parentF = 0: tick = tick + 1
  569. '        yStart = max(fruit.Y - tick, 0): yStop = min(fruit.Y + tick, sqrsY - 1)
  570. '        REDIM map2(sqrsX - 1, sqrsY - 1) AS STRING '    need a 2nd map to hold all new stuff until
  571. '        FOR y = 0 TO sqrsY - 1 '                                          the entire square coverd
  572. '            FOR x = 0 TO sqrsX - 1
  573. '                map2(x, y) = " "
  574. '            NEXT
  575. '        NEXT
  576. '        FOR y = yStart TO yStop
  577. '            xStart = max(fruit.X - tick, 0): xStop = min(fruit.X + tick, sqrsX - 1)
  578. '            FOR x = xStart TO xStop
  579. '                'check out the neighbors
  580. '                IF map(x, y) = " " OR map(x, y) = "H" THEN
  581. '                    IF map(x, y) = "H" THEN foundHead = -1
  582. '                    IF y - 1 >= 0 THEN
  583. '                        IF INSTR("UDLRF", map(x, y - 1)) THEN
  584. '                            map2(x, y) = "U": parentF = 1
  585. '                            IF foundHead THEN headMarked = -1
  586. '                        END IF
  587. '                    END IF
  588. '                    IF y + 1 <= sqrsY - 1 THEN
  589. '                        IF INSTR("UDLRF", map(x, y + 1)) THEN
  590. '                            map2(x, y) = "D": parentF = 1
  591. '                            IF foundHead THEN headMarked = -1
  592. '                        END IF
  593. '                    END IF
  594. '                    IF x + 1 <= sqrsX - 1 THEN
  595. '                        IF INSTR("UDLRF", map(x + 1, y)) THEN
  596. '                            map2(x, y) = "R": parentF = 1
  597. '                            IF foundHead THEN headMarked = -1
  598. '                        END IF
  599. '                    END IF
  600. '                    IF x - 1 >= 0 THEN
  601. '                        IF INSTR("UDLRF", map(x - 1, y)) THEN
  602. '                            map2(x, y) = "L": parentF = 1
  603. '                            IF foundHead THEN headMarked = -1
  604. '                        END IF
  605. '                    END IF
  606. '                END IF
  607. '            NEXT
  608. '        NEXT
  609. '        FOR y = 0 TO sqrsY - 1 'transfer data to map
  610. '            FOR x = 0 TO sqrsX - 1
  611. '                IF map2(x, y) <> " " THEN map(x, y) = map2(x, y): changeF = 1
  612. '            NEXT
  613. '        NEXT
  614. '    WEND 'if no ParentF then dead connection to Fruit
  615. '    SELECT CASE map(head.X, head.Y)
  616. '        CASE "H" ' cause crash because no connection to fruit found
  617. '            IF change.X THEN change.X = -change.X ELSE change.Y = -change.Y 'make Body crash
  618. '            ' change.X = 0: change.Y = 0 '   this will switch auto control off to avoid program hang, dang still hangs!
  619. '        CASE "D": change.X = 0: change.Y = 1
  620. '        CASE "U": change.X = 0: change.Y = -1
  621. '        CASE "R": change.X = 1: change.Y = 0
  622. '        CASE "L": change.X = -1: change.Y = 0
  623. '    END SELECT
  624. 'END SUB
  625.  
  626.  
  627. SUB snakeBrainBplus4 ' real AI, responds to real time information
  628.     'STATIC xLim, yLim, dat$(sqrsX - 1, sqrsY - 1)
  629.     DIM xlim, ylim, bodyStack
  630.     xlim = sqrsX - 1: ylim = sqrsY - 1
  631.     'IF dat$(0, 0) <> "D" THEN GOSUB setupdat 'haven't been here yet
  632.  
  633.     bodyStack = INT(sLen / 40) 'these are integers so 0 for first 40
  634.     yHeadLimit = ylim - bodyStack * 2 + 1
  635.  
  636.     'IF head.Y >= yHeadLimit THEN '<<<<<<<<<<<<<<<<< go up om even when stacking
  637.     'IF head.X MOD 2 = 0 THEN 'even row  includes top row
  638.     '    IF head.X = 0 THEN
  639.     '        IF head.Y <> ylim THEN
  640.     '            change.X = 0: change.Y = 1
  641.     '        ELSE
  642.     '            change.X = 1: change.Y = 0
  643.     '        END IF
  644.     '    ELSEIF head.X = 1 THEN
  645.     '        IF head.Y <> 0 THEN
  646.     '            change.X = 0: change.Y = -1
  647.     '        ELSE
  648.     '            change.X = -1: change.Y = 0
  649.     '        END IF
  650.     '    ELSEIF head.X > 1 AND head.X < xlim THEN
  651.     '        change.X = -1: change.Y = 0
  652.     '    ELSEIF head.X = xlim THEN
  653.     '        change.X = -1: change.Y = 0
  654.     '    END IF
  655.     'ELSE 'head.x mod 2 = 1  'includes bottom row
  656.  
  657.     '    IF head.X = 0 THEN
  658.     '        IF head.Y = ylim THEN
  659.     '            change.X = 1: change.Y = 0
  660.     '        ELSE
  661.     '            change.X = 0: change.Y = 1
  662.     '        END IF
  663.     '    ELSEIF head.X >= 1 AND head.X <> xlim THEN 'crashing on bottom line
  664.     '        change.X = 1: change.Y = 0
  665.     '    ELSEIF head.X = xlim THEN
  666.     '        change.X = 0: change.Y = -1
  667.     '    END IF
  668.     'END IF
  669.     'ELSE ' head.y < yheadlimit
  670.     IF head.X = 0 THEN
  671.         IF head.Y <> ylim THEN
  672.             change.X = 0: change.Y = 1
  673.         ELSE
  674.             change.X = 1: change.Y = 0
  675.         END IF
  676.     ELSEIF head.X >= 1 AND head.X < xlim THEN
  677.         IF head.Y = ylim THEN
  678.             change.X = 1: change.Y = 0
  679.         ELSE
  680.             change.X = -1: change.Y = 0
  681.         END IF
  682.     ELSEIF head.X = xlim THEN
  683.         IF head.Y = 0 THEN
  684.             change.X = -1: change.Y = 0
  685.         ELSEIF head.Y = fruit.Y AND fruit.Y < ylim THEN
  686.             change.X = -1: change.Y = 0
  687.         ELSE
  688.             change.X = 0: change.Y = -1
  689.         END IF
  690.     END IF
  691.     'END IF
  692.     EXIT SUB
  693.  
  694.     'setupdat:
  695.     'FOR y = 0 TO yLim
  696.     '    FOR x = 0 TO xLim
  697.     '        IF x = 0 AND y <> yLim THEN ' left side
  698.     '            dat$(x, y) = "D"
  699.     '        ELSEIF x = 0 AND y = yLim THEN 'bottom, left corner
  700.     '            dat$(x, y) = "R"
  701.     '        ELSEIF x <> xLim AND y = yLim THEN 'bottom row
  702.     '            dat$(x, y) = "R"
  703.     '        ELSEIF x = xLim AND y MOD 2 = 1 THEN ' right side up odd
  704.     '            dat$(x, y) = "U"
  705.     '        ELSEIF x = xLim AND y MOD 2 = 0 THEN 'right side left even
  706.     '            dat$(x, y) = "L"
  707.     '        ELSEIF y MOD 2 = 0 AND x = 1 AND y <> 0 THEN ' left coil even turn up
  708.     '            dat$(x, y) = "U"
  709.     '        ELSEIF y MOD 2 = 0 AND x = 1 AND y = 0 THEN 'left coil even on top row
  710.     '            dat$(x, y) = "L"
  711.     '        ELSEIF y MOD 2 = 1 AND x <> 1 THEN 'coil odd row
  712.     '            dat$(x, y) = "R"
  713.     '        ELSEIF y MOD 2 = 1 AND x = 1 AND y <> yLim THEN ' coil odd row
  714.     '            dat$(x, y) = "R"
  715.     '        ELSEIF y MOD 2 = 0 AND x <> 1 THEN 'coil even
  716.     '            dat$(x, y) = "L"
  717.     '        ELSEIF y MOD 2 = 0 AND x = 1 THEN 'coil even
  718.     '            dat$(x, y) = "R"
  719.     '        END IF
  720.     '    NEXT
  721.     'NEXT
  722.     'RETURN
  723.  

Marked as best answer/most recent update by bplus on March 24, 2020, 01:47:23 AM

Offline bplus

  • Forum Resident
  • Posts: 7118
  • b = b + ...
Re: Smart Snake
« Reply #25 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]
  1. _TITLE "Snake AI-1_8 Trailblazer" 'b+ 2020-03-23 and Ashish SUB snakeBrainAshish1
  2.  
  3. '2020-03-14 Snake AI-1 first post
  4. '2020-03-16  Snake AI-1_1 there must be overlap of the snake somewhere! Aha!
  5. '2020-03-17 Snake AI-1_2 fix the duplicate segment problem
  6. ' Now a new mystery, an ocassional flashing duplicate box
  7. '2020-03-17 Install standard snake rules for testing brain evolving
  8. ' First setup XY type and rename and convert variables using XY type.
  9. ' 2nd Make snake brain and whole game only dependent sqrsX, sqrsY and sq for screen size
  10. ' Got it!!! the code ends with hangup head next to fruit with 99 (1 cell less that whole board)
  11. ' cells of snake length, no new place can be found for fruit, perfect finish and no duplicate
  12. ' cells! PLUS now can turn on a dime go up one colume and down the next in 2 key press.
  13. ' Now add autoPilot on -1 / off 0 toggle control, OK snake rules tested when human pilots snake.
  14. ' Help screen & independent speeds for human or AI.
  15. '2020-03-18  "Snake AI-1_4 fix tester" The AI tester needs to save Head(x, y) in case the AI
  16. ' does not change the head(x, y) or tries to move it diagonally.
  17. '2020-03-18 Snake AI-1_5 SHARE change AS XY
  18. ' DIM SHARE change AS XY or change.x, change.y replaces variables called dx, dy.
  19. ' I decided to switch over to human control if AI fails to return a proper change.
  20. ' AI must leave change.x, change.y ready for human to take over control which means my changing
  21. ' the code for toggling the autopilot and adding change.x, change.y updates in my snakeBrain SUB.
  22. ' Rewrite SnakeBrain using only change.X and change.Y now. A BEEP will indicate an AI error and
  23. ' signal control returned to human. This noted in Key Help part of screen.
  24. '2020-03-19 Snake AI-1_6 B+brain#2 begin a new snakeBrainBplus2 sub routine
  25. ' Add a driver report in title bar along with sLen.
  26. ' Oh hey what a fancy snake dance, not the least bit faster than snakeBrainBplus1.
  27. '2020-03-20 Snake AI-1_7 real AI
  28. ' RE: snakeBrainBplus2
  29. ' Recode snakeBrainBplus2 to be self contained in one SUB, load data for the array it uses inside
  30. ' that SUB. It also has to check sqrsX, sqrsY to be sure they are correct, this is pure novelty
  31. ' SUB so will set sqrsX, sqrsY back to 20 each for standard game AI setting. OK good!
  32. ' RE: sqrsX, sqrsY
  33. ' sqrsX, sqrsY reset back to 20, 20 for standard setup for testing AI.
  34. ' RE: Ashish first "real AI" very excellent submission!
  35. ' Attempt to incorporate Ashish "real AI" as SUB snakeBrainAshish1
  36. ' Ashish is using $CONSOLE and DIM SHARED state$ but I don't see why so I made state$ STATIC in
  37. ' his SUB and took console out, though I can see it might be needed later. Working here yeah!
  38. ' RE: SnakeBrainBplus3, bplus first "real AI" also working pretty well to a point.
  39. ' SnakeBrainBplus3 uses real AI and crashes when snake can't get to fruit due to it's length
  40. ' either by inaccessible fruit, snakes body blocks head or head buried in body and can't escape.
  41. ' Using lessons learned from Pathfinder work.
  42.  
  43. '2020-03-21 Snake AI-1_8 Trailblazer   a Smarter Snake!
  44. ' As described at forum today, entice snake to safely coil itself before going after fruit at
  45. ' each increase of it's length. Does't look like this will work out.
  46. ' 3-22 try Trailblazer square attack pattern, looks simpler can we connect to safe coil map?
  47. ' No connection yet: crash, crash, crash.... my brain is broken!
  48. ' 3-23 New idea for connnecting square frame pattern for fruit catching to the safe coil map.
  49. ' Looking good! 2-320's 2-360s and 2-perfect 399! Generalize variables for any even field and