Author Topic: Wolfram Science Explorer  (Read 3008 times)

0 Members and 1 Guest are viewing this topic.

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Wolfram Science Explorer
« on: December 26, 2020, 08:13:31 pm »
You have probably seen these pictures before... Now you can see where they come from!

EDIT: Now with zoom.

Code: QB64: [Select]
  1. ' Version 2020-12-28
  2. '
  3. ' 111 110 101 100 011 010 001 000
  4. '  A   B   C   D   E   F   G   H
  5. '
  6. ' Each of A-H can be either 0 or 1.
  7. ' There are 2^8=256 possible rules.
  8.  
  9.  
  10. _TITLE "Wolfram Automata"
  11.  
  12. ' Hardware.
  13. SCREEN _NEWIMAGE(1024, 768, 32)
  14.  
  15. ' Structure(s) to hold table of rules.
  16. TYPE EightVector
  17.     A AS INTEGER
  18.     B AS INTEGER
  19.     C AS INTEGER
  20.     D AS INTEGER
  21.     E AS INTEGER
  22.     F AS INTEGER
  23.     G AS INTEGER
  24.     H AS INTEGER
  25. DIM SHARED Rules(256) AS EightVector
  26.  
  27. ' Overall dimension of plot.
  28. DIM SHARED DomainWidth AS INTEGER
  29. DIM SHARED ZoomFactor AS INTEGER
  30. ZoomFactor = 8
  31. DomainWidth = _WIDTH - 1
  32.  
  33.  
  34. ' State arrays and variables.
  35. DIM SHARED CurrentState(DomainWidth) AS INTEGER
  36. DIM SHARED NextState(DomainWidth) AS INTEGER
  37. DIM SHARED PresentRule AS INTEGER
  38.  
  39. ' Initialize.
  40. CALL LoadRules
  41. PresentRule = 31
  42. CALL UpdateAndDraw(PresentRule, 0)
  43. 'CALL AutoPlay
  44.  
  45. ' Main Loop
  46.     CALL KeyProcess
  47.     _KEYCLEAR
  48.     _LIMIT 30
  49.  
  50.  
  51. SUB KeyProcess
  52.     DIM k AS INTEGER
  53.     k = _KEYHIT
  54.     SELECT CASE (k)
  55.         CASE 18432
  56.             IF (ZoomFactor = 1) THEN ZoomFactor = 0
  57.             ZoomFactor = ZoomFactor + 2
  58.             IF (ZoomFactor > 64) THEN ZoomFactor = 64
  59.             CALL UpdateAndDraw(PresentRule, 0)
  60.         CASE 20480
  61.             ZoomFactor = ZoomFactor - 2
  62.             IF (ZoomFactor < 2) THEN ZoomFactor = 1
  63.             CALL UpdateAndDraw(PresentRule, 0)
  64.         CASE 19712
  65.             PresentRule = PresentRule + 1
  66.             IF (PresentRule > 256) THEN PresentRule = 1
  67.             CALL UpdateAndDraw(PresentRule, 0)
  68.         CASE 19200
  69.             PresentRule = PresentRule - 1
  70.             IF (PresentRule < 1) THEN PresentRule = 256
  71.             CALL UpdateAndDraw(PresentRule, 0)
  72.         CASE ASC("r"), ASC("R")
  73.             CALL UpdateAndDraw(PresentRule, 1)
  74.         CASE ASC(" ")
  75.             CALL UpdateAndDraw(PresentRule, 0)
  76.         CASE ASC("2")
  77.             CALL UpdateAndDraw(PresentRule, 2)
  78.     END SELECT
  79.  
  80. SUB AutoPlay
  81.     DIM k AS INTEGER
  82.     SLEEP 3
  83.     DO
  84.         FOR k = 1 TO 256
  85.             CALL UpdateAndDraw(k, 0)
  86.             SLEEP 2
  87.             CALL UpdateAndDraw(k, 1)
  88.             SLEEP 2
  89.         NEXT
  90.     LOOP
  91.     PresentRule = 31
  92.  
  93. SUB UpdateAndDraw (r AS INTEGER, s AS INTEGER)
  94.     DIM a AS STRING
  95.     DIM j AS INTEGER
  96.  
  97.     CALL InitializeState(s)
  98.  
  99.     CLS
  100.     PAINT (_WIDTH / 2, _HEIGHT / 2), _RGB32(255, 255, 255, 255)
  101.     FOR j = 1 TO (INT((DomainWidth / ZoomFactor) / 2) - 1) '(INT((DomainWidth / ZoomFactor) / 2) - 1)
  102.         CALL PlotState(j)
  103.         CALL UpdateState(r)
  104.     NEXT
  105.  
  106.     COLOR _RGB32(0, 0, 0, 255), _RGB32(255, 255, 255, 255)
  107.     a = "Rule:" + STR$(r - 1) + " of 255"
  108.     _PRINTSTRING (_WIDTH / 2 - (LEN(a) / 2) * 8, _HEIGHT - (14) * 16), a
  109.  
  110.     j = (_WIDTH - 560) / 2
  111.     CALL DrawRuleKey(j, 585, 1, 1, 1, Rules(r).A)
  112.     j = j + 80
  113.     CALL DrawRuleKey(j, 585, 1, 1, 0, Rules(r).B)
  114.     j = j + 80
  115.     CALL DrawRuleKey(j, 585, 1, 0, 1, Rules(r).C)
  116.     j = j + 80
  117.     CALL DrawRuleKey(j, 585, 1, 0, 0, Rules(r).D)
  118.     j = j + 80
  119.     CALL DrawRuleKey(j, 585, 0, 1, 1, Rules(r).E)
  120.     j = j + 80
  121.     CALL DrawRuleKey(j, 585, 0, 1, 0, Rules(r).F)
  122.     j = j + 80
  123.     CALL DrawRuleKey(j, 585, 0, 0, 1, Rules(r).G)
  124.     j = j + 80
  125.     CALL DrawRuleKey(j, 585, 0, 0, 0, Rules(r).H)
  126.  
  127.     COLOR _RGB32(0, 0, 0, 255), _RGB32(255, 255, 255, 255)
  128.  
  129.     IF (s = 0) THEN a = "Seed: Standard" ELSE a = "Seed: Random"
  130.     _PRINTSTRING (_WIDTH / 2 - (LEN(a) / 2) * 8, _HEIGHT - (8) * 16), a
  131.  
  132.     a = "Zoom:" + STR$(ZoomFactor)
  133.     _PRINTSTRING (_WIDTH / 2 - (LEN(a) / 2) * 8, _HEIGHT - (6) * 16), a
  134.  
  135.     a = "* Use Up/Down arrows to change zoom.   "
  136.     _PRINTSTRING (_WIDTH / 2 - (LEN(a) / 2) * 8, _HEIGHT - (4) * 16), a
  137.  
  138.     a = "* Use Left/Right arrows to change rule."
  139.     _PRINTSTRING (_WIDTH / 2 - (LEN(a) / 2) * 8, _HEIGHT - (3) * 16), a
  140.  
  141.     a = "* Press R for random initial condition."
  142.     _PRINTSTRING (_WIDTH / 2 - (LEN(a) / 2) * 8, _HEIGHT - (2) * 16), a
  143.  
  144.     _DISPLAY
  145.  
  146. SUB UpdateState (RuleNumber AS INTEGER)
  147.     DIM k AS INTEGER
  148.     DIM a AS INTEGER
  149.     DIM b AS INTEGER
  150.     DIM c AS INTEGER
  151.     FOR k = 1 TO UBOUND(CurrentState)
  152.         IF (k = 1) THEN
  153.             a = CurrentState(k)
  154.         ELSE
  155.             a = CurrentState(k - 1)
  156.         END IF
  157.         b = CurrentState(k)
  158.         IF k = (UBOUND(CurrentState)) THEN
  159.             c = CurrentState(k)
  160.         ELSE
  161.             c = CurrentState(k + 1)
  162.         END IF
  163.         IF ((a = 1) AND (b = 1) AND (c = 1)) THEN NextState(k) = Rules(RuleNumber).A
  164.         IF ((a = 1) AND (b = 1) AND (c = 0)) THEN NextState(k) = Rules(RuleNumber).B
  165.         IF ((a = 1) AND (b = 0) AND (c = 1)) THEN NextState(k) = Rules(RuleNumber).C
  166.         IF ((a = 1) AND (b = 0) AND (c = 0)) THEN NextState(k) = Rules(RuleNumber).D
  167.         IF ((a = 0) AND (b = 1) AND (c = 1)) THEN NextState(k) = Rules(RuleNumber).E
  168.         IF ((a = 0) AND (b = 1) AND (c = 0)) THEN NextState(k) = Rules(RuleNumber).F
  169.         IF ((a = 0) AND (b = 0) AND (c = 1)) THEN NextState(k) = Rules(RuleNumber).G
  170.         IF ((a = 0) AND (b = 0) AND (c = 0)) THEN NextState(k) = Rules(RuleNumber).H
  171.     NEXT
  172.     FOR k = 1 TO UBOUND(CurrentState)
  173.         CurrentState(k) = NextState(k)
  174.     NEXT
  175.  
  176. SUB PlotState (y AS INTEGER)
  177.     DIM k AS INTEGER
  178.     DIM xx AS DOUBLE
  179.     DIM p AS INTEGER
  180.     p = INT(UBOUND(CurrentState) / 2) + 1
  181.     xx = p * (1 - 1 / ZoomFactor)
  182.  
  183.     IF (ZoomFactor < 2) THEN
  184.         FOR k = p TO 1 STEP -1
  185.             IF (CurrentState(k) = 1) THEN
  186.                 PSET ((k - xx), y), _RGBA(0, 0, 0, 255)
  187.             END IF
  188.             IF (CurrentState(2 * p - k) = 1) THEN
  189.                 PSET ((2 * p - k - xx), y), _RGBA(0, 0, 0, 255)
  190.             END IF
  191.         NEXT
  192.     ELSE
  193.         FOR k = p TO p - INT(p / ZoomFactor) + 1 STEP -1
  194.             IF (CurrentState(k) = 1) THEN
  195.                 LINE (ZoomFactor * ((k - xx) - 1 / 2), ZoomFactor * (y - 1))-(ZoomFactor * ((k - xx) + 1 / 2), ZoomFactor * y), _RGBA(0, 0, 0, 255), BF
  196.             ELSE
  197.                 LINE (ZoomFactor * ((k - xx) - 1 / 2), ZoomFactor * (y - 1))-(ZoomFactor * ((k - xx) + 1 / 2), ZoomFactor * y), _RGBA(0, 0, 0, 20), BF
  198.             END IF
  199.             IF (k <> p) THEN
  200.                 IF (CurrentState(2 * p - k) = 1) THEN
  201.                     LINE (ZoomFactor * ((2 * p - k - xx) - 1 / 2), ZoomFactor * (y - 1))-(ZoomFactor * ((2 * p - k - xx) + 1 / 2), ZoomFactor * y), _RGBA(0, 0, 0, 255), BF
  202.                 ELSE
  203.                     LINE (ZoomFactor * ((2 * p - k - xx) - 1 / 2), ZoomFactor * (y - 1))-(ZoomFactor * ((2 * p - k - xx) + 1 / 2), ZoomFactor * y), _RGBA(0, 0, 0, 20), BF
  204.                 END IF
  205.             END IF
  206.         NEXT
  207.     END IF
  208.  
  209. SUB InitializeState (x AS INTEGER)
  210.     DIM k AS INTEGER
  211.     SELECT CASE x
  212.         CASE 0
  213.             FOR k = 1 TO UBOUND(CurrentState)
  214.                 CurrentState(k) = 0
  215.             NEXT
  216.             CurrentState((UBOUND(CurrentState) - 1) / 2 + 1) = 1
  217.         CASE 1
  218.             RANDOMIZE x
  219.             FOR k = 1 TO UBOUND(CurrentState)
  220.                 IF RND > .5 THEN
  221.                     CurrentState(k) = 1
  222.                 ELSE
  223.                     CurrentState(k) = 0
  224.                 END IF
  225.             NEXT
  226.         CASE 2
  227.             FOR k = 1 TO UBOUND(CurrentState) - 4 STEP 4
  228.                 CurrentState(k) = 1
  229.                 CurrentState(k + 1) = 1
  230.                 CurrentState(k + 2) = 0
  231.                 CurrentState(k + 3) = 0
  232.             NEXT
  233.     END SELECT
  234.  
  235. SUB LoadRules
  236.     DIM j AS INTEGER
  237.     DIM a AS STRING
  238.     FOR j = 0 TO 255
  239.         a = IntToB2$(j)
  240.         Rules(j + 1).A = VAL(MID$(a, 1, 1))
  241.         Rules(j + 1).B = VAL(MID$(a, 2, 1))
  242.         Rules(j + 1).C = VAL(MID$(a, 3, 1))
  243.         Rules(j + 1).D = VAL(MID$(a, 4, 1))
  244.         Rules(j + 1).E = VAL(MID$(a, 5, 1))
  245.         Rules(j + 1).F = VAL(MID$(a, 6, 1))
  246.         Rules(j + 1).G = VAL(MID$(a, 7, 1))
  247.         Rules(j + 1).H = VAL(MID$(a, 8, 1))
  248.     NEXT
  249.  
  250. FUNCTION IntToB2$ (x AS INTEGER) ' Valid for x:[0,255]
  251.     DIM TheReturn AS STRING
  252.     DIM n AS INTEGER
  253.     DIM a AS INTEGER
  254.     n = x
  255.     DO WHILE (n > 0)
  256.         a = n MOD 2
  257.         n = n \ 2
  258.         TheReturn = LTRIM$(STR$(a)) + TheReturn
  259.     LOOP
  260.     TheReturn = RIGHT$("00000000" + TheReturn, 8)
  261.     IntToB2$ = TheReturn
  262.  
  263. SUB DrawRuleKey (x AS DOUBLE, y AS DOUBLE, i AS INTEGER, j AS INTEGER, k AS INTEGER, l AS INTEGER)
  264.     DIM xx AS DOUBLE
  265.     DIM yy AS DOUBLE
  266.     xx = x - 20
  267.     yy = y
  268.     SELECT CASE i
  269.         CASE 0
  270.             LINE (xx - 10, yy - 10)-(xx + 10, yy + 10), _RGB32(255, 255, 255, 255), BF
  271.         CASE 1
  272.             LINE (xx - 10, yy - 10)-(xx + 10, yy + 10), _RGB32(0, 0, 0, 255), BF
  273.     END SELECT
  274.     LINE (xx - 10, yy - 10)-(xx + 10, yy + 10), _RGB32(200, 200, 200, 255), B
  275.     xx = x
  276.     SELECT CASE j
  277.         CASE 0
  278.             LINE (xx - 10, yy - 10)-(xx + 10, yy + 10), _RGB32(255, 255, 255, 255), BF
  279.         CASE 1
  280.             LINE (xx - 10, yy - 10)-(xx + 10, yy + 10), _RGB32(0, 0, 0, 255), BF
  281.     END SELECT
  282.     LINE (xx - 10, yy - 10)-(xx + 10, yy + 10), _RGB32(200, 200, 200, 255), B
  283.     xx = x + 20
  284.     SELECT CASE k
  285.         CASE 0
  286.             LINE (xx - 10, yy - 10)-(xx + 10, yy + 10), _RGB32(255, 255, 255, 255), BF
  287.         CASE 1
  288.             LINE (xx - 10, yy - 10)-(xx + 10, yy + 10), _RGB32(0, 0, 0, 255), BF
  289.     END SELECT
  290.     LINE (xx - 10, yy - 10)-(xx + 10, yy + 10), _RGB32(200, 200, 200, 255), B
  291.     xx = x
  292.     yy = y + 20
  293.     SELECT CASE l
  294.         CASE 0
  295.             LINE (xx - 10, yy - 10)-(xx + 10, yy + 10), _RGB32(255, 255, 255, 255), BF
  296.         CASE 1
  297.             LINE (xx - 10, yy - 10)-(xx + 10, yy + 10), _RGB32(0, 0, 0, 255), BF
  298.     END SELECT
  299.     LINE (xx - 10, yy - 10)-(xx + 10, yy + 10), _RGB32(200, 200, 200, 255), B
rule 30.png
* rule 30.png (Filesize: 93.54 KB, Dimensions: 1024x768, Views: 221)
rule 45.png
* rule 45.png (Filesize: 74.62 KB, Dimensions: 1024x768, Views: 232)
rule 73.png
* rule 73.png (Filesize: 91.91 KB, Dimensions: 1024x768, Views: 223)
rule 90.png
* rule 90.png (Filesize: 13.88 KB, Dimensions: 1024x768, Views: 221)
« Last Edit: December 28, 2020, 11:28:00 pm by STxAxTIC »
You're not done when it works, you're done when it's right.

FellippeHeitor

  • Guest
Re: Wolfram Science Explorer
« Reply #1 on: December 26, 2020, 08:20:35 pm »
Illuminati confirmed.