Sandpiles

[Ashish]

Hi everyone! This month is going to be very serious and exhausting for me.
The below program shows a basic demo for Abelian Sandpile Model. https://en.wikipedia.org/wiki/Abelian_sandpile_model
 Please note that rendering this stuff to full size is very time consuming.

Code: QB64: [Select]

1. '1 Grain -> Black
2. '2 Grain -> Yellow
3. '3 Grain -> Blue
4. '4 Grain -> Red
5. _TITLE "Sandpiles by Ashish"
6. SCREEN _NEWIMAGE(200, 200, 32)
7. DIM grain(_WIDTH, _HEIGHT) AS _UNSIGNED LONG, grain_back(_WIDTH, _HEIGHT) AS _UNSIGNED LONG
8.  
9. grain(_WIDTH / 2, _HEIGHT / 2) = 500000
10. CLS , _RGB(255, 255, 255)
11.  
12. DO
13.  
14.     $CHECKING:OFF
15.     FOR i = 0 TO 500
16.         FOR y = 1 TO _HEIGHT - 1
17.             FOR x = 1 TO _WIDTH - 1
18.                 IF i = 500 THEN
19.                     IF grain(x, y) = 1 THEN
20.                         PSET (x, y), _RGB(0, 0, 0)
21.                     ELSEIF grain(x, y) = 2 THEN
22.                         PSET (x, y), _RGB(255, 255, 0)
23.                     ELSEIF grain(x, y) = 3 THEN
24.                         PSET (x, y), _RGB(0, 0, 255)
25.                     ELSEIF grain(x, y) = 4 THEN
26.                         PSET (x, y), _RGB(255, 0, 0)
27.                     END IF
28.                 END IF
29.                 IF y >= 1 AND x >= 1 THEN
30.                     IF grain(x, y) > 4 THEN
31.                         grain(x - 1, y) = grain(x - 1, y) + 1
32.                         grain(x + 1, y) = grain(x + 1, y) + 1
33.                         grain(x, y + 1) = grain(x, y + 1) + 1
34.                         grain(x, y - 1) = grain(x, y - 1) + 1
35.                         grain(x, y) = grain(x, y) - 4
36.  
37.                         grain_back(x - 1, y) = grain(x - 1, y)
38.                         grain_back(x + 1, y) = grain(x + 1, y)
39.                         grain_back(x, y - 1) = grain(x, y - 1)
40.                         grain_back(x, y + 1) = grain(x, y + 1)
41.                         grain_back(x, y) = grain(x, y)
42.                     END IF
43.                 END IF
44.         NEXT x, y
45.     NEXT
46.     $CHECKING:ON
47.     SWAP grain, grain_back
48.     _DISPLAY
49.     '_LIMIT 60
50. LOOP
51.  

The above picture took 63 minute to render.

[bplus]

Hi everyone! This month is going to be very serious and exhausting for me.
The below program shows a basic demo for Abelian Sandpile Model. https://en.wikipedia.org/wiki/Abelian_sandpile_model
 Please note that rendering this stuff to full size is very time consuming.

Code: QB64: [Select]

1. '1 Grain -> Black
2. '2 Grain -> Yellow
3. '3 Grain -> Blue
4. '4 Grain -> Red
5. _TITLE "Sandpiles by Ashish"
6. SCREEN _NEWIMAGE(200, 200, 32)
7. DIM grain(_WIDTH, _HEIGHT) AS _UNSIGNED LONG, grain_back(_WIDTH, _HEIGHT) AS _UNSIGNED LONG
8.  
9. grain(_WIDTH / 2, _HEIGHT / 2) = 500000
10. CLS , _RGB(255, 255, 255)
11.  
12. DO
13.  
14.     $CHECKING:OFF
15.     FOR i = 0 TO 500
16.         FOR y = 1 TO _HEIGHT - 1
17.             FOR x = 1 TO _WIDTH - 1
18.                 IF i = 500 THEN
19.                     IF grain(x, y) = 1 THEN
20.                         PSET (x, y), _RGB(0, 0, 0)
21.                     ELSEIF grain(x, y) = 2 THEN
22.                         PSET (x, y), _RGB(255, 255, 0)
23.                     ELSEIF grain(x, y) = 3 THEN
24.                         PSET (x, y), _RGB(0, 0, 255)
25.                     ELSEIF grain(x, y) = 4 THEN
26.                         PSET (x, y), _RGB(255, 0, 0)
27.                     END IF
28.                 END IF
29.                 IF y >= 1 AND x >= 1 THEN
30.                     IF grain(x, y) > 4 THEN
31.                         grain(x - 1, y) = grain(x - 1, y) + 1
32.                         grain(x + 1, y) = grain(x + 1, y) + 1
33.                         grain(x, y + 1) = grain(x, y + 1) + 1
34.                         grain(x, y - 1) = grain(x, y - 1) + 1
35.                         grain(x, y) = grain(x, y) - 4
36.  
37.                         grain_back(x - 1, y) = grain(x - 1, y)
38.                         grain_back(x + 1, y) = grain(x + 1, y)
39.                         grain_back(x, y - 1) = grain(x, y - 1)
40.                         grain_back(x, y + 1) = grain(x, y + 1)
41.                         grain_back(x, y) = grain(x, y)
42.                     END IF
43.                 END IF
44.         NEXT x, y
45.     NEXT
46.     $CHECKING:ON
47.     SWAP grain, grain_back
48.     _DISPLAY
49.     '_LIMIT 60
50. LOOP
51.  

Hi Ashish,

I ran your code and looks like symmetry is off. Try this:

Code: QB64: [Select]

1. _TITLE "Sandpiles by Ashish mod for symmetry and color by B+ 2019-03-04"
2. CONST w = &HFFFFFFFF
3. CONST y4 = &HFFFFFF00
4. CONST y3 = &HFFAA8811
5. CONST y2 = &HFF774444
6. CONST y1 = &HFF332266
7.  
8. SCREEN _NEWIMAGE(600, 600, 32)
9. _SCREENMOVE 300, 100
10. DIM grain(600, 600) AS _UNSIGNED LONG
11. DIM ng(600, 600) AS _UNSIGNED LONG 'next generation grain
12.  
13. grain(300, 300) = 500000
14. CLS , _RGB(255, 255, 255)
15.  
16. DO
17.     FOR y = 1 TO 599
18.         FOR x = 1 TO 599
19.  
20.             IF grain(x, y) = 1 THEN
21.                 PSET (x, y), y1
22.             ELSEIF grain(x, y) = 2 THEN
23.                 PSET (x, y), y2
24.             ELSEIF grain(x, y) = 3 THEN
25.                 PSET (x, y), y3
26.             ELSEIF grain(x, y) = 4 THEN
27.                 PSET (x, y), y4
28.             ELSEIF grain > 4 THEN
29.                 PSET (x, y), w
30.             END IF
31.  
32.             IF grain(x, y) > 4 THEN 'update next generation array NOT this generation array
33.                 ng(x - 1, y) = ng(x - 1, y) + 1
34.                 ng(x + 1, y) = ng(x + 1, y) + 1
35.                 ng(x, y + 1) = ng(x, y + 1) + 1
36.                 ng(x, y - 1) = ng(x, y - 1) + 1
37.                 ng(x, y) = ng(x, y) - 4
38.  
39.             END IF
40.     NEXT x, y
41.  
42.     'copy ng() into grain()  ' AFTER UPDATING ALL OF NG()
43.     FOR y = 0 TO 600
44.         FOR x = 0 TO 600
45.             grain(x, y) = ng(x, y)
46.         NEXT
47.     NEXT
48. LOOP WHILE grain(300, 300) > 4
49.  
50.  

Update after 1 hour run:
 

After 4 hours running:
 

[bplus]

Update after 6 hour run:

 

[bplus]

Oh!!!

Code: QB64: [Select]

1.             ELSEIF grain > 4 THEN
2.                 PSET (x, y), w
3.  

That's why I never saw a white pixel in the middle! Ha! no biggy but should be:

Code: QB64: [Select]

1.             ELSEIF grain(x, y) > 4 THEN
2.                 PSET (x, y), w
3.  

Append: Oh it makes a big difference, you can see where grains exceed 4 for the pixel ie watch the grains spread out better.

[bplus]

Pixels that are white (inside the pile) are places where the sand grains exceed 4:
 

[Ed Davis]

Oh!!!

Code: QB64: [Select]

1.             ELSEIF grain > 4 THEN
2.                 PSET (x, y), w
3.  

Why wasn't that a syntax error?  grain is declared as:

Code: QB64: [Select]

1. DIM grain(600, 600) AS _UNSIGNED LONG
2.  

Shouldn't the compiler have caught that, and saved you the trouble?   Just wondering ....

[FellippeHeitor]

If he had added OPTION _EXPLICIT to the top of his program, the compiler would have warned of an undeclared variable being used. Without OPTION _EXPLICIT you simply have an array grain(600, 600) of type unsigned long and a variable grain of type single. All valid in BASIC.

[bplus]

I have modified the color system again and magnified pixels to small boxes:

Code: QB64: [Select]

1. _TITLE "Sandpiles by Ashish, mod #2 B+ 2019-03-04 new color system and magnification"
2. ' from "Sandpiles by Ashish mod for symmetry and color by B+ 2019-03-04"
3.  
4. CONST w = &HFFFFFFFF
5. CONST y4 = &HFFFFBB00
6. CONST y3 = &HFFBB6600
7. CONST y2 = &HFF884400
8. CONST y1 = &HFF5500
9. CONST b = &HFF000000
10.  
11. SCREEN _NEWIMAGE(600, 600, 32)
12. _SCREENMOVE 300, 100
13. DIM grain(300, 300) AS _UNSIGNED LONG
14. DIM ng(300, 300) AS _UNSIGNED LONG 'next generation grain
15.  
16. grain(150, 150) = 500000
17. CLS
18.  
19. DO
20.     FOR y = 1 TO 299
21.         FOR x = 1 TO 299
22.             IF grain(x, y) = 0 THEN
23.                 LINE (x * 2, y * 2)-STEP(1, 1), b, BF
24.             ELSEIF grain(x, y) = 1 THEN
25.                 'PSET (x, y), y1
26.                 LINE (x * 2, y * 2)-STEP(1, 1), y1, BF
27.             ELSEIF grain(x, y) = 2 THEN
28.                 'PSET (x, y), y2
29.                 LINE (x * 2, y * 2)-STEP(1, 1), y2, BF
30.             ELSEIF grain(x, y) = 3 THEN
31.                 'PSET (x, y), y3
32.                 LINE (x * 2, y * 2)-STEP(1, 1), y3, BF
33.             ELSEIF grain(x, y) = 4 THEN
34.                 'PSET (x, y), y4
35.                 LINE (x * 2, y * 2)-STEP(1, 1), y4, BF
36.             ELSEIF grain(x, y) > 4 AND grain(x, y) < 256 THEN
37.                 'PSET (x, y), _RGB32(255, 255, grain(x, y))
38.                 LINE (x * 2, y * 2)-STEP(1, 1), _RGB32(255, 255, grain(x, y)), BF
39.             ELSEIF grain(x, y) > 255 THEN
40.                 'PSET (x, y), w
41.                 LINE (x * 2, y * 2)-STEP(1, 1), w, BF
42.             END IF
43.  
44.             IF grain(x, y) > 4 THEN 'update next generation array NOT this generation array
45.                 ng(x - 1, y) = ng(x - 1, y) + 1
46.                 ng(x + 1, y) = ng(x + 1, y) + 1
47.                 ng(x, y + 1) = ng(x, y + 1) + 1
48.                 ng(x, y - 1) = ng(x, y - 1) + 1
49.                 ng(x, y) = ng(x, y) - 4
50.  
51.             END IF
52.     NEXT x, y
53.  
54.     'copy ng() into grain()  ' AFTER UPDATING ALL OF NG()
55.     FOR y = 0 TO 300
56.         FOR x = 0 TO 300
57.             grain(x, y) = ng(x, y)
58.         NEXT
59.     NEXT
60.     _LIMIT 300
61. LOOP WHILE grain(150, 150) > 4
62.  
63.  

An hour's run:
 

[Ashish]

Great bplus! Thanks for adding your contribution to this.