Wolfram Science Explorer

[STxAxTIC]

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

[FellippeHeitor]

Illuminati confirmed.