« previous next »
Pages: [1]   Go Down

Author Topic: Cellular Automata  (Read 3219 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
Cellular Automata
« on: February 28, 2018, 05:51:17 am »
At IRC this morning the subject of Cellular Automata came up.

Since I am advocating reposting Golden Oldies from NET here is sample of one of my long time favorites, Classic John Conway Life:
Code: QB64: [Select]
  1. _TITLE "Quick Life trans for QB64 11-06.82  2017-11-11by bplus"
  2. ' From: quick life.bas SmallBASIC (not MS) B+ G7 stripped down to favorite setting
  3. '
  4. ' To: the one out there who has checked out Conway's Life the last couple of days.
  5. ' For you, a working version (albeit highly modified) of Conway's Life code in QB64.
  6. '
  7. ' Quote Rules (from Wiki):
  8. ' The universe of the Game of Life is an infinite two-dimensional orthogonal grid of square cells,
  9. ' each of which is in one of two possible states, alive or dead, or "populated" or "unpopulated".
  10. ' Every cell interacts with its eight neighbours, which are the cells that are horizontally,
  11. ' vertically, or diagonally adjacent. At each step in time, the following transitions occur:
  12. ' 1) Any live cell with fewer than two live neighbours dies, as if caused by underpopulation.
  13. ' 2) Any live cell with two or three live neighbours lives on to the next generation.
  14. ' 3) Any live cell with more than three live neighbours dies, as if by overpopulation.
  15. ' 4) Any dead cell with exactly three live neighbours becomes a live cell, as if by reproduction.
  16. ' The initial pattern constitutes the seed of the system.
  17. ' The first generation is created by applying the above rules simultaneously to every cell in the
  18. ' seed—births and deaths occur simultaneously, and the discrete moment at which this happens is
  19. ' sometimes called a tick (in other words, each generation is a pure function of the preceding one).
  20. ' The rules continue to be applied repeatedly to create further generations.
  21. ' (End Quote)
  22.  
  23. ' Alas in practical applications we do not have infinite board to play Life, so at boundries rules
  24. ' break down as neighbor counts are only 5 max on edge and only 3 max at corners.
  25.  
  26. 'This code is very easy to modify into other tests / demos:
  27. ' Try coloring by neighbor counts.
  28. ' Try other rules besides Classic 2,3 neighbors = survive, 3 neighbors = birth.
  29. ' Try regenration along the borders every other generation, which causes symetric beauties!
  30. ' Change an = the number of cells per side, even amounts that divide 700 (pixels per board side) work best.
  31.  
  32. CONST xmax = 700
  33. CONST ymax = 700
  34.  
  35. SCREEN _NEWIMAGE(xmax, ymax, 32)
  36. _SCREENMOVE 360, 20
  37.  
  38. 'DEFINT A-Z
  39. DIM qb&(15) 'thanks Andy Amaya for use with his sub qColor fore, back
  40. qb&(0) = _RGB(0, 0, 0) '       black
  41. qb&(1) = _RGB(0, 0, 128) '     blue
  42. qb&(2) = _RGB(8, 128, 8) '     green
  43. qb&(3) = _RGB(0, 128, 128) '   cyan
  44. qb&(4) = _RGB(128, 0, 0) '     red
  45. qb&(5) = _RGB(128, 0, 128) '   magenta
  46. qb&(6) = _RGB(128, 64, 32) '   brown
  47. qb&(7) = _RGB(168, 168, 168) ' white
  48. qb&(8) = _RGB(128, 128, 128) ' grey
  49. qb&(9) = _RGB(84, 84, 252) '   light blue
  50. qb&(10) = _RGB(42, 252, 42) '  light green
  51. qb&(11) = _RGB(0, 220, 220) '  light cyan
  52. qb&(12) = _RGB(255, 0, 0) '    light red
  53. qb&(13) = _RGB(255, 84, 255) ' light magenta
  54. qb&(14) = _RGB(255, 255, 0) '  yellow
  55. qb&(15) = _RGB(255, 255, 255) 'bright white
  56.  
  57. 'test colors
  58. 'FOR i = 0 TO 15
  59. '    PRINT i,
  60. '    LINE (100, 100)-(500, 500), qb&(i), BF
  61. '    _LIMIT 1
  62. 'NEXT
  63.  
  64. an = 70: s = INT(ymax / an): bigBlock = an * s: g = 0
  65. DIM a(1 TO an, 1 TO an), ng(1 TO an, 1 TO an), ls(1 TO an, 1 TO an)
  66.  
  67. 'seed for Conway's Life Classic
  68. FOR y = 2 TO an - 1
  69.     FOR x = 2 TO an - 1
  70.  
  71.         ' a(x, y) = INT(RND * 2)  'for random mess
  72.  
  73.         'for symmetric line
  74.         IF y = an / 2 OR y = an / 2 + 1 THEN a(x, y) = 1
  75.  
  76.     NEXT
  78.  
  79. WHILE INKEY$ <> " "
  80.  
  81.     ' Mandala Life regeneration of Mandala like arrays, seeds every other generation along edges
  82.     'IF g MOD 2 = 0 THEN
  83.     'FOR x = 1 TO an
  84.     '    a(x, 1) = 1: a(x, an) = 1: a(1, x) = 1: a(an, x) = 1
  85.     'NEXT
  86.     'END IF
  87.  
  88.     FOR x = 2 TO an - 1
  89.         FOR y = 2 TO an - 1
  90.             pc = a(x - 1, y - 1) + a(x - 1, y) + a(x - 1, y + 1) + a(x, y - 1) + a(x, y + 1) + a(x + 1, y - 1) + a(x + 1, y) + a(x + 1, y + 1)
  91.             ls(x, y) = pc
  92.             r$ = RIGHT$(STR$(pc), 1)
  93.             IF a(x, y) THEN 'cell is alive so what is surviveRule
  94.  
  95.                 'Bplus favorite Mandala Life Rules for survival and birth
  96.                 'IF INSTR("2346", r$) THEN ng(x, y) = 1 ELSE ng(x, y) = 0
  97.  
  98.                 'Classic Conway's Life Rules
  99.                 IF INSTR("23", r$) THEN ng(x, y) = 1 ELSE ng(x, y) = 0
  100.  
  101.             ELSE 'birth?
  102.  
  103.                 'Bplus favorite Mandala Life Rules for survival and birth
  104.                 'IF INSTR("34", r$) THEN ng(x, y) = 1 ELSE ng(x, y) = 0
  105.  
  106.                 'Classic Conway's Life Rules
  107.                 IF INSTR("3", r$) THEN ng(x, y) = 1 ELSE ng(x, y) = 0
  108.             END IF
  109.         NEXT
  110.     NEXT
  111.  
  112.     'Bplus favorite Mandala Life Rules for survival and birth
  113.     'LINE (1, 1)-(bigBlock, bigBlock), qb&(0), BF
  114.  
  115.     'Classic Conway's Life Rules
  116.     LINE (1, 1)-(bigBlock, bigBlock), qb&(1), BF
  117.     FOR y = 1 TO an
  118.         FOR x = 1 TO an
  119.             IF a(x, y) THEN 'show old a with it's neighbor counts br yellow or black
  120.  
  121.                 'Bplus favorite Mandala Life Rules for survival and birth
  122.                 'LINE ((x - 1) * s + 1, (y - 1) * s + 1)-STEP(s, s), qb&(0), BF
  123.  
  124.                 'this separates into individual cells for Classic look
  125.                 LINE ((x - 1) * s + 1, (y - 1) * s + 1)-STEP(s - 2, s - 2), qb&(15), BF
  126.  
  127.                 'Mandala Life coloring by neighbor counts
  128.                 'ELSE
  129.                 '    lc = ls(x, y)
  130.                 '    SELECT CASE lc
  131.                 '        CASE 0: cl = 15 ' br white
  132.                 '        CASE 1: cl = 11 ' cyan
  133.                 '        CASE 2: cl = 7 '  low white, br gray
  134.                 '        CASE 3: cl = 10 ' light green
  135.                 '        CASE 4: cl = 9 '  blue
  136.                 '        CASE 5: cl = 13 ' violet
  137.                 '        CASE 6: cl = 12 ' br red
  138.                 '        CASE 7: cl = 4 '  dark red
  139.                 '        CASE 8: cl = 0 '  black
  140.                 '    END SELECT
  141.                 '    LINE ((x - 1) * s + 1, (y - 1) * s + 1)-STEP(s, s), qb&(cl), BF
  142.  
  143.             END IF
  144.         NEXT
  145.     NEXT
  146.     _DISPLAY
  147.     FOR y = 1 TO an
  148.         FOR x = 1 TO an
  149.             a(x, y) = ng(x, y) 'load a() with next generation data
  150.         NEXT
  151.     NEXT
  152.     g = g + 1
  153.     _LIMIT 10
  155.  


And here is Mandala Life, mod of classic rules and coloring:
Code: QB64: [Select]
  1. _TITLE "Mandala Life trans for QB64 11-06.82  2017-11-11 by bplus"
  2. ' From: quick life.bas SmallBASIC (not MS) B+ G7 stripped down to favorite setting
  3. '
  4. ' To: the one out there who has checked out Conway's Life the last couple of days.
  5. ' For you, a working version (albeit highly modified) of Conway's Life code in QB64.
  6. '
  7. ' Quote Rules (from Wiki):
  8. ' The universe of the Game of Life is an infinite two-dimensional orthogonal grid of square cells,
  9. ' each of which is in one of two possible states, alive or dead, or "populated" or "unpopulated".
  10. ' Every cell interacts with its eight neighbours, which are the cells that are horizontally,
  11. ' vertically, or diagonally adjacent. At each step in time, the following transitions occur:
  12. ' 1) Any live cell with fewer than two live neighbours dies, as if caused by underpopulation.
  13. ' 2) Any live cell with two or three live neighbours lives on to the next generation.
  14. ' 3) Any live cell with more than three live neighbours dies, as if by overpopulation.
  15. ' 4) Any dead cell with exactly three live neighbours becomes a live cell, as if by reproduction.
  16. ' The initial pattern constitutes the seed of the system.
  17. ' The first generation is created by applying the above rules simultaneously to every cell in the
  18. ' seed—births and deaths occur simultaneously, and the discrete moment at which this happens is
  19. ' sometimes called a tick (in other words, each generation is a pure function of the preceding one).
  20. ' The rules continue to be applied repeatedly to create further generations.
  21. ' (End Quote)
  22.  
  23. ' Alas in practical applications we do not have infinite board to play Life, so at boundries rules
  24. ' break down as neighbor counts are only 5 max on edge and only 3 max at corners.
  25.  
  26. 'This code is very easy to modify into other tests / demos:
  27. ' Try coloring by neighbor counts.
  28. ' Try other rules besides Classic 2,3 neighbors = survive, 3 neighbors = birth.
  29. ' Try regenration along the borders every other generation, which causes symetric beauties!
  30. ' Change an = the number of cells per side, even amounts that divide 700 (pixels per board side) work best.
  31.  
  32. CONST xmax = 700
  33. CONST ymax = 700
  34.  
  35. SCREEN _NEWIMAGE(xmax, ymax, 32)
  36. _SCREENMOVE 360, 20
  37.  
  38. 'DEFINT A-Z
  39. DIM qb&(15) 'thanks Andy Amaya for use with his sub qColor fore, back
  40. qb&(0) = _RGB(0, 0, 0) '       black
  41. qb&(1) = _RGB(0, 0, 128) '     blue
  42. qb&(2) = _RGB(8, 128, 8) '     green
  43. qb&(3) = _RGB(0, 128, 128) '   cyan
  44. qb&(4) = _RGB(128, 0, 0) '     red
  45. qb&(5) = _RGB(128, 0, 128) '   magenta
  46. qb&(6) = _RGB(128, 64, 32) '   brown
  47. qb&(7) = _RGB(168, 168, 168) ' white
  48. qb&(8) = _RGB(128, 128, 128) ' grey
  49. qb&(9) = _RGB(84, 84, 252) '   light blue
  50. qb&(10) = _RGB(42, 252, 42) '  light green
  51. qb&(11) = _RGB(0, 220, 220) '  light cyan
  52. qb&(12) = _RGB(255, 0, 0) '    light red
  53. qb&(13) = _RGB(255, 84, 255) ' light magenta
  54. qb&(14) = _RGB(255, 255, 0) '  yellow
  55. qb&(15) = _RGB(255, 255, 255) 'bright white
  56.  
  57. 'test colors
  58. 'FOR i = 0 TO 15
  59. '    PRINT i,
  60. '    LINE (100, 100)-(500, 500), qb&(i), BF
  61. '    _LIMIT 1
  62. 'NEXT
  63.  
  64. an = 140: s = INT(ymax / an): bigBlock = an * s: g = 0
  65. DIM a(1 TO an, 1 TO an), ng(1 TO an, 1 TO an), ls(1 TO an, 1 TO an)
  66.  
  67. 'seed for Conway's Life Classic
  68. 'FOR y = 2 TO an - 1
  69. '    FOR x = 2 TO an - 1
  70.  
  71. '        ' a(x, y) = INT(RND * 2)  'for random mess
  72.  
  73. '        'for symmetric line
  74. '        IF y = an / 2 OR y = an / 2 + 1 THEN a(x, y) = 1
  75.  
  76. '    NEXT
  77. 'NEXT
  78.  
  79. WHILE INKEY$ <> " "
  80.  
  81.     ' Mandala Life regeneration of Mandala like arrays, seeds every other generation along edges
  82.     IF g MOD 2 = 0 THEN
  83.         FOR x = 1 TO an
  84.             a(x, 1) = 1: a(x, an) = 1: a(1, x) = 1: a(an, x) = 1
  85.         NEXT
  86.     END IF
  87.  
  88.     FOR x = 2 TO an - 1
  89.         FOR y = 2 TO an - 1
  90.             pc = a(x - 1, y - 1) + a(x - 1, y) + a(x - 1, y + 1) + a(x, y - 1) + a(x, y + 1) + a(x + 1, y - 1) + a(x + 1, y) + a(x + 1, y + 1)
  91.             ls(x, y) = pc
  92.             r$ = RIGHT$(STR$(pc), 1)
  93.             IF a(x, y) THEN 'cell is alive so what is surviveRule
  94.  
  95.                 'Bplus favorite Mandala Life Rules for survival and birth
  96.                 IF INSTR("2346", r$) THEN ng(x, y) = 1 ELSE ng(x, y) = 0
  97.  
  98.                 'Classic Conway's Life Rules
  99.                 'IF INSTR("23", r$) THEN ng(x, y) = 1 ELSE ng(x, y) = 0
  100.  
  101.             ELSE 'birth?
  102.  
  103.                 'Bplus favorite Mandala Life Rules for survival and birth
  104.                 IF INSTR("34", r$) THEN ng(x, y) = 1 ELSE ng(x, y) = 0
  105.  
  106.                 'Classic Conway's Life Rules
  107.                 'IF INSTR("3", r$) THEN ng(x, y) = 1 ELSE ng(x, y) = 0
  108.             END IF
  109.         NEXT
  110.     NEXT
  111.  
  112.     'Bplus favorite Mandala Life Rules for survival and birth
  113.     LINE (1, 1)-(bigBlock, bigBlock), qb&(0), BF
  114.  
  115.     'Classic Conway's Life Rules
  116.     'LINE (1, 1)-(bigBlock, bigBlock), qb&(1), BF
  117.     FOR y = 1 TO an
  118.         FOR x = 1 TO an
  119.             IF a(x, y) THEN 'show old a with it's neighbor counts br yellow or black
  120.  
  121.                 'Bplus favorite Mandala Life Rules for survival and birth
  122.                 LINE ((x - 1) * s + 1, (y - 1) * s + 1)-STEP(s, s), qb&(0), BF
  123.  
  124.                 'this separates into individual cells for Classic look
  125.                 'LINE ((x - 1) * s + 1, (y - 1) * s + 1)-STEP(s - 2, s - 2), qb&(15), BF
  126.  
  127.                 'Mandala Life coloring by neighbor counts
  128.             ELSE
  129.                 lc = ls(x, y)
  130.                 SELECT CASE lc
  131.                     CASE 0: cl = 15 ' br white
  132.                     CASE 1: cl = 11 ' cyan
  133.                     CASE 2: cl = 7 '  low white, br gray
  134.                     CASE 3: cl = 10 ' light green
  135.                     CASE 4: cl = 9 '  blue
  136.                     CASE 5: cl = 13 ' violet
  137.                     CASE 6: cl = 12 ' br red
  138.                     CASE 7: cl = 4 '  dark red
  139.                     CASE 8: cl = 0 '  black
  140.                 END SELECT
  141.                 LINE ((x - 1) * s + 1, (y - 1) * s + 1)-STEP(s, s), qb&(cl), BF
  142.  
  143.             END IF
  144.         NEXT
  145.     NEXT
  146.     _DISPLAY
  147.     FOR y = 1 TO an
  148.         FOR x = 1 TO an
  149.             a(x, y) = ng(x, y) 'load a() with next generation data
  150.         NEXT
  151.     NEXT
  152.     g = g + 1
  153.     IF g > 70 THEN _LIMIT 1
  155.  

If anyone else has worked in Cellular Automata, I would be very interested in seeing your posts.
Quick Life.PNG
* Quick Life.PNG (Filesize: 43.44 KB, Dimensions: 991x749, Views: 474)
Mandala Life.PNG
* Mandala Life.PNG (Filesize: 125.51 KB, Dimensions: 1007x754, Views: 452)
« Last Edit: February 28, 2018, 05:56:57 am by bplus »
Logged
Pages: [1]   Go Up
« previous next »