Author Topic: Amazing Rat  (Read 6866 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Amazing Rat
« on: June 15, 2018, 04:52:00 pm »
Here is some RI (Rodent Intelligence):
Code: QB64: [Select]
  1. _TITLE "Amazing rat B+ trans 2018-06-15"
  2. 'from SmallBASIC to QB64 version 2017 1106/82 (the day before they switched to version 1.2)
  3. '2018-06-15 added more fun!
  4.  
  5. 'rat runs whole maze.bas for SmallBASIC 0.12.6 [B+MGA] 2016-06-30
  6. ' mod of Chris maze gererator post
  7. ' Backtracking maze generator
  8. ' https://en.wikipedia.org/wiki/Maze_generation_algorithm
  9. '
  10. ' - Starting from a random cell,
  11. ' - Selects a random neighbouring cell that has not been visited.
  12. ' - Remove the wall between the two cells and marks the new cell as visited,
  13. '   and adds it to the stack to facilitate backtracking.
  14. ' - Continues with a cell that has no unvisited neighbours being considered a dead-end.
  15. '   When at a dead-end it backtracks through the path until it reaches a cell with an
  16. '   unvisited neighbour, continuing the path generation by visiting this new,
  17. '   unvisited cell (creating a new junction).
  18. '   This process continues until every cell has been visited, backtracking all the
  19. '   way back to the beginning cell. We can be sure every cell is visited.
  20. '
  21. ' model consts
  22.  
  23. CONST xmax = 1200
  24. CONST ymax = 700
  25.  
  26. SCREEN _NEWIMAGE(xmax, ymax, 32)
  27. _SCREENMOVE 100, 20
  28.  
  29. CONST W = 48
  30. CONST H = 28
  31. CONST margin = 25
  32. CONST border = margin / 2
  33.  
  34. TYPE cell
  35.     x AS INTEGER
  36.     y AS INTEGER
  37.  
  38. DIM SHARED cellW
  39. cellW = (xmax - margin) / W
  40. DIM SHARED cellH
  41. cellH = (ymax - margin) / H
  42. DIM SHARED h_walls(W, H)
  43. DIM SHARED v_walls(W, H)
  44. pi = _PI
  45.  
  46. ' What's a maze with out a little white mouse?
  47.  
  48.  
  49. init_walls
  50. generate_maze
  51. rX = 0: rY = 0: rd = 180
  52. DIM trail AS cell
  53. ti = 0
  54. cheese = 0
  55. chx = INT(RND * (W - 1)) + 1
  56. chy = INT(RND * (H - 1)) + 1
  57.     'maze board
  58.     COLOR _RGB32(155, 75, 32)
  59.     recf 0, 0, xmax, ymax
  60.     show_maze
  61.  
  62.     'add to trail
  63.     ti = ti + 1
  64.     REDIM _PRESERVE trail(ti) AS cell
  65.     trail(ti).x = border + (rX + .5) * cellW
  66.     trail(ti).y = border + (rY + .5) * cellH
  67.  
  68.     'bread crumbs or whatever...
  69.     COLOR _RGBA(8, 4, 2, 40)
  70.     FOR i = 1 TO ti
  71.         fcirc trail(i).x, trail(i).y, 2
  72.     NEXT
  73.  
  74.     'draw cheese
  75.     COLOR _RGB32(200, 180, 0)
  76.     fcirc border + (chx + .5) * cellW, border + (chy + .5) * cellH, .25 * cellH
  77.  
  78.     'draw mouse
  79.     drawRat border + rX * cellW, border + rY * cellH, cellW, cellH, rd, cheese
  80.  
  81.     'mouse find the cheese?
  82.     IF rX = chx AND rY = chy THEN
  83.         cheese = cheese + 1
  84.         chx = INT(RND * (W - 1)) + 1
  85.         chy = INT(RND * (H - 1)) + 1
  86.         ti = 0
  87.         REDIM trail(ti) AS cell
  88.         _DELAY 1
  89.     END IF
  90.  
  91.  
  92.     _DISPLAY
  93.     _DELAY .2
  94.     'setup next move
  95.     SELECT CASE rd
  96.         CASE 0
  97.             IF h_walls(rX, rY + 1) = 0 THEN
  98.                 rY = rY + 1: rd = 90
  99.             ELSEIF v_walls(rX + 1, rY) = 0 THEN
  100.                 rX = rX + 1
  101.             ELSEIF h_walls(rX, rY) = 0 THEN
  102.                 rY = rY - 1: rd = 270
  103.             ELSE
  104.                 rX = rX - 1: rd = 180
  105.             END IF
  106.  
  107.         CASE 90
  108.             IF v_walls(rX, rY) = 0 THEN
  109.                 rX = rX - 1: rd = 180
  110.             ELSEIF h_walls(rX, rY + 1) = 0 THEN
  111.                 rY = rY + 1
  112.             ELSEIF v_walls(rX + 1, rY) = 0 THEN
  113.                 rX = rX + 1: rd = 0
  114.             ELSE
  115.                 rY = rY - 1: rd = 270
  116.             END IF
  117.  
  118.         CASE 180
  119.             IF h_walls(rX, rY) = 0 THEN
  120.                 rY = rY - 1: rd = 270
  121.             ELSEIF v_walls(rX, rY) = 0 THEN
  122.                 rX = rX - 1
  123.             ELSEIF h_walls(rX, rY + 1) = 0 THEN
  124.                 rY = rY + 1: rd = 90
  125.             ELSE
  126.                 rX = rX + 1: rd = 0
  127.             END IF
  128.  
  129.         CASE 270
  130.             IF v_walls(rX + 1, rY) = 0 THEN
  131.                 rX = rX + 1: rd = 0
  132.             ELSEIF h_walls(rX, rY) = 0 THEN
  133.                 rY = rY - 1
  134.             ELSEIF v_walls(rX, rY) = 0 THEN
  135.                 rX = rX - 1: rd = 180
  136.             ELSE
  137.                 rY = rY + 1: rd = 90
  138.             END IF
  139.     END SELECT
  140.  
  141.  
  142. SUB init_walls ()
  143.     FOR x = 0 TO W
  144.         FOR y = 0 TO H
  145.             v_walls(x, y) = 1
  146.             h_walls(x, y) = 1
  147.         NEXT
  148.     NEXT
  149.  
  150. SUB show_maze ()
  151.     COLOR _RGB32(180, 90, 45)
  152.     'cls
  153.     py = border
  154.     FOR y = 0 TO H
  155.         px = border
  156.         FOR x = 0 TO W
  157.             IF x < W AND h_walls(x, y) = 1 THEN
  158.                 recf px, py, px + cellW, py + 2
  159.             END IF
  160.             IF y < H AND v_walls(x, y) = 1 THEN
  161.                 recf px, py, px + 2, py + cellH
  162.             END IF
  163.             px = px + cellW
  164.         NEXT
  165.         py = py + cellH
  166.     NEXT
  167.  
  168. SUB rand_cell (rWx, rHy)
  169.     rWx = INT(RND * 1000) MOD W
  170.     rHy = INT(RND * 1000) MOD H
  171.  
  172. SUB get_unvisited (visited(), current AS cell, unvisited() AS cell, uvi)
  173.     'local n
  174.     REDIM unvisited(0) AS cell
  175.     x = current.x
  176.     y = current.y
  177.     uvi = 0
  178.     IF x > 0 THEN
  179.         IF visited(x - 1, y) = 0 THEN
  180.             uvi = uvi + 1
  181.             REDIM _PRESERVE unvisited(uvi) AS cell
  182.             unvisited(uvi).x = x - 1
  183.             unvisited(uvi).y = y
  184.         END IF
  185.     END IF
  186.     IF x < W - 1 THEN
  187.         IF visited(x + 1, y) = 0 THEN
  188.             uvi = uvi + 1
  189.             REDIM _PRESERVE unvisited(uvi) AS cell
  190.             unvisited(uvi).x = x + 1
  191.             unvisited(uvi).y = y
  192.         END IF
  193.     END IF
  194.     IF y > 0 THEN
  195.         IF visited(x, y - 1) = 0 THEN
  196.             uvi = uvi + 1
  197.             REDIM _PRESERVE unvisited(uvi) AS cell
  198.             unvisited(uvi).x = x
  199.             unvisited(uvi).y = y - 1
  200.         END IF
  201.     END IF
  202.     IF y < H - 1 THEN
  203.         IF visited(x, y + 1) = 0 THEN
  204.             uvi = uvi + 1
  205.             REDIM _PRESERVE unvisited(uvi) AS cell
  206.             unvisited(uvi).x = x
  207.             unvisited(uvi).y = y + 1
  208.         END IF
  209.     END IF
  210.  
  211. SUB generate_maze ()
  212.     'local curr_cell, next_cell, num_visited, num_cells, visited, stack, cells
  213.     'local x, y
  214.     DIM visited(W, H)
  215.     REDIM stack(0) AS cell
  216.     DIM curr_cell AS cell
  217.     DIM next_cell AS cell
  218.     rand_cell cur_cell.x, cur_cell.y
  219.     visited(curr_cell.x, curr_cell.y) = 1
  220.     num_visited = 1
  221.     num_cells = W * H
  222.     si = 0
  223.     WHILE num_visited < num_cells
  224.         REDIM cells(0) AS cell
  225.         cnt = 0
  226.         get_unvisited visited(), curr_cell, cells(), cnt
  227.         IF cnt > 0 THEN
  228.             ' choose randomly one of the current cell's unvisited neighbours
  229.             rc = INT(RND * 100) MOD cnt + 1
  230.             next_cell.x = cells(rc).x
  231.             next_cell.y = cells(rc).y
  232.  
  233.             ' push the current cell to the stack
  234.             si = si + 1
  235.             REDIM _PRESERVE stack(si) AS cell
  236.             stack(si).x = curr_cell.x
  237.             stack(si).y = curr_cell.y
  238.  
  239.             ' remove the wall between the current cell and the chosen cell
  240.             IF next_cell.x = curr_cell.x THEN
  241.                 x = next_cell.x
  242.                 y = max(next_cell.y, curr_cell.y)
  243.                 h_walls(x, y) = 0
  244.             ELSE
  245.                 x = max(next_cell.x, curr_cell.x)
  246.                 y = next_cell.y
  247.                 v_walls(x, y) = 0
  248.             END IF
  249.  
  250.             ' make the chosen cell the current cell and mark it as visited
  251.             curr_cell.x = next_cell.x
  252.             curr_cell.y = next_cell.y
  253.             visited(curr_cell.x, curr_cell.y) = 1
  254.             num_visited = num_visited + 1
  255.         ELSEIF si > 0 THEN
  256.             ' pop a cell from the stack and make it the current cell
  257.             curr_cell.x = stack(si).x
  258.             curr_cell.y = stack(si).y
  259.             si = si - 1
  260.             REDIM _PRESERVE stack(si) AS cell
  261.  
  262.         ELSE
  263.             EXIT WHILE
  264.         END IF
  265.     WEND
  266.  
  267.  
  268. SUB drawRat (leftX, topY, cwidth, cheight, heading, cheese)
  269.     COLOR _RGB32(225, 225, 225)
  270.     'local bcX, bcY, bR, neckX, neckY
  271.     bcX = leftX + .5 * cwidth
  272.     bcY = topY + .5 * cheight
  273.     bR = .5 * .5 * min(cwidth, cheight)
  274.     'local noseX :
  275.     noseX = bcX + 2 * bR * COS(rad(heading))
  276.     'local noseY :
  277.     noseY = bcY + 2 * bR * SIN(rad(heading))
  278.     neckX = bcX + .75 * bR * COS(rad(heading))
  279.     neckY = bcY + .75 * bR * SIN(rad(heading))
  280.     'local tailX :
  281.     tailX = bcX + 2 * bR * COS(rad(heading + 180))
  282.     'local tailY :
  283.     tailY = bcY + 2 * bR * SIN(rad(heading + 180))
  284.     'local earLX :
  285.     earLX = bcX + bR * COS(rad(heading - 30))
  286.     'local earLY :
  287.     earLY = bcY + bR * SIN(rad(heading - 30))
  288.     'local earRX :
  289.     earRX = bcX + bR * COS(rad(heading + 30))
  290.     'local earRY :
  291.     earRY = bcY + bR * SIN(rad(heading + 30))
  292.  
  293.     fcirc bcX, bcY, .65 * bR + 2 * cheese
  294.     fcirc neckX, neckY, bR * .3
  295.     ftri noseX, noseY, earLX, earLY, earRX, earRY, _RGB32(225, 225, 225)
  296.     fcirc earLX, earLY, bR * .3
  297.     fcirc earRX, earRY, bR * .3
  298.  
  299.     wX = .7 * bR * COS(rad(heading - 90 - 20))
  300.     wY = .7 * bR * SIN(rad(heading - 90 - 20))
  301.     ln noseX + wX, noseY + wY, noseX - wX, noseY - wY
  302.     wX = .7 * bR * COS(rad(heading - 90 + 20))
  303.     wY = .7 * bR * SIN(rad(heading - 90 + 20))
  304.     ln noseX + wX, noseY + wY, noseX - wX, noseY - wY
  305.     ln bcX, bcY, tailX, tailY
  306.  
  307. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  308. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  309.     DIM subRadius AS LONG, RadiusError AS LONG
  310.     DIM X AS LONG, Y AS LONG
  311.  
  312.     subRadius = ABS(R)
  313.     RadiusError = -subRadius
  314.     X = subRadius
  315.     Y = 0
  316.  
  317.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  318.  
  319.     ' Draw the middle span here so we don't draw it twice in the main loop,
  320.     ' which would be a problem with blending turned on.
  321.     LINE (CX - X, CY)-(CX + X, CY), , BF
  322.  
  323.     WHILE X > Y
  324.         RadiusError = RadiusError + Y * 2 + 1
  325.         IF RadiusError >= 0 THEN
  326.             IF X <> Y + 1 THEN
  327.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  328.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  329.             END IF
  330.             X = X - 1
  331.             RadiusError = RadiusError - X * 2
  332.         END IF
  333.         Y = Y + 1
  334.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  335.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  336.     WEND
  337.  
  338. ' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]:    http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
  339. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  340.     a& = _NEWIMAGE(1, 1, 32)
  341.     _DEST a&
  342.     PSET (0, 0), K
  343.     _DEST 0
  344.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  345.     _FREEIMAGE a& '<<< this is important!
  346.  
  347. SUB ln (x1, y1, x2, y2)
  348.     LINE (x1, y1)-(x2, y2)
  349.  
  350. SUB rec (x1, y1, x2, y2)
  351.     LINE (x1, y1)-(x2, y2), , B
  352.  
  353. SUB recf (x1, y1, x2, y2)
  354.     LINE (x1, y1)-(x2, y2), , BF
  355.  
  356. FUNCTION max (a, b)
  357.     IF a > b THEN max = a ELSE max = b
  358.  
  359. FUNCTION min (a, b)
  360.     IF a > b THEN min = b ELSE min = a
  361.  
  362. FUNCTION rad (a)
  363.     rad = a * pi / 180
  364.  
« Last Edit: June 15, 2018, 04:54:31 pm by bplus »

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Amazing Rat
« Reply #1 on: June 16, 2018, 03:50:34 am »
Hi bplus! Which pathfinding algorithm does the program uses? I see some here - https://en.wikipedia.org/wiki/Pathfinding
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 johnno56

  • Forum Resident
  • Posts: 1270
  • Live long and prosper.
    • View Profile
Re: Amazing Rat
« Reply #2 on: June 16, 2018, 07:57:27 am »
Very cool. Could be used as a type of screensaver... Almost hypnotic... Almost felt like cheering for the mouse... until I remembered that mice are rodents... I watched until the mouse had navigated about half of the maze and figured it would probably die of starvation before it found the cheese...  Mesmerizing entertainment... One odd side effect... After terminating the program I developed a hankering for Swiss cheese....
Logic is the beginning of wisdom.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Amazing Rat
« Reply #3 on: June 16, 2018, 10:15:10 am »
Hi bplus! Which pathfinding algorithm does the program uses? I see some here - https://en.wikipedia.org/wiki/Pathfinding

I used the Greek method of removing oneself from a maze, it is completely brainless in that it requires 0 memory (well you do have to remember the trick), study the pattern of turns in the main routine.

The maze itself is guaranteed to be accessible to any cell. So the cheese can be put anywhere and the mouse will get to it, eventually... but you have to wait longer than Johnno. ;-))

« Last Edit: June 16, 2018, 10:26:56 am by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Amazing Rat
« Reply #4 on: June 16, 2018, 10:17:29 am »
Very cool. Could be used as a type of screensaver... Almost hypnotic... Almost felt like cheering for the mouse... until I remembered that mice are rodents... I watched until the mouse had navigated about half of the maze and figured it would probably die of starvation before it found the cheese...  Mesmerizing entertainment... One odd side effect... After terminating the program I developed a hankering for Swiss cheese....

Dang Johnno, you missed the best part. What happens when the mouse does get the cheese and again and again... :P

Oh hey! Johnno if you drank too much coffee and can't wait so long, set W and H to less cells. That's how I tested the code.

BTW, if you don't like rats, have I got an app for you!
« Last Edit: June 16, 2018, 10:42:54 am by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Amazing Rat
« Reply #5 on: June 16, 2018, 11:59:40 am »
Here is 12x 7 with a couple of cheese hits:
12 x 7.PNG
* 12 x 7.PNG (Filesize: 18.84 KB, Dimensions: 1204x729, Views: 376)

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Amazing Rat
« Reply #6 on: June 16, 2018, 12:25:25 pm »
Hi bplus! Which pathfinding algorithm does the program uses? I see some here - https://en.wikipedia.org/wiki/Pathfinding
I used the Greek method of removing oneself from a maze, it is completely brainless in that it requires 0 memory (well you do have to remember the trick), study the pattern of turns in the main routine.

If that is completely brainless then how this is rodent intelligence ❓❓
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

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Amazing Rat
« Reply #7 on: June 16, 2018, 12:44:05 pm »
How is AI intelligent? That is truly brainless.

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Amazing Rat
« Reply #8 on: June 16, 2018, 01:05:59 pm »
Nice one, bplus, i like the dots.  Needs a scary serpent in there as well.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Amazing Rat
« Reply #9 on: June 16, 2018, 01:06:47 pm »
I was thinking Pac Rat!

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Amazing Rat
« Reply #10 on: June 16, 2018, 03:19:47 pm »
Hi Bplus
Yes Pac Rat... but for its mode to eat cheese I should say  Pac Boa Rat :-)
Fine the algorithm of  binary choose preferring for first the right side.

Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Amazing Rat
« Reply #11 on: June 16, 2018, 08:23:40 pm »
Oh hey! How about a version of the snake game with a moving target!

Append: No? a snake can't back up, it would have to be played above the mouse tunnels. Still a moving target would be a twist.
« Last Edit: June 16, 2018, 09:36:17 pm by bplus »

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Amazing Rat
« Reply #12 on: June 17, 2018, 05:08:48 am »
I like it, Bplus :-D