Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: Ashish on March 04, 2019, 10:10:09 am

Title: Sandpiles
Post by: Ashish on March 04, 2019, 10:10:09 am
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)
  8.  
  9. grain(_WIDTH / 2, _HEIGHT / 2) = 500000
  10. CLS , _RGB(255, 255, 255)
  11.  
  13.  
  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
  47.     SWAP grain, grain_back
  48.     _DISPLAY
  49.     '_LIMIT 60
  51.  
 [ This attachment cannot be displayed inline in 'Print Page' view ]  
The above picture took 63 minute to render.
Title: Re: Sandpiles
Post by: bplus on March 04, 2019, 05:43:23 pm
Quote from: Ashish on March 04, 2019, 10:10:09 am
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)
  8.  
  9. grain(_WIDTH / 2, _HEIGHT / 2) = 500000
  10. CLS , _RGB(255, 255, 255)
  11.  
  13.  
  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
  47.     SWAP grain, grain_back
  48.     _DISPLAY
  49.     '_LIMIT 60
  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.  
  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:
 
Title: Re: Sandpiles
Post by: bplus on March 04, 2019, 11:47:18 pm
Update after 6 hour run:

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Sandpiles
Post by: bplus on March 05, 2019, 09:00:33 am
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.
Title: Re: Sandpiles
Post by: bplus on March 05, 2019, 09:36:33 am
Pixels that are white (inside the pile) are places where the sand grains exceed 4:
  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Sandpiles
Post by: Ed Davis on March 05, 2019, 09:55:42 am
Quote from: bplus on March 05, 2019, 09:00:33 am
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 ....
Title: Re: Sandpiles
Post by: FellippeHeitor on March 05, 2019, 09:58:35 am
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.
Title: Re: Sandpiles
Post by: bplus on March 05, 2019, 11:51:22 am
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
  18.  
  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:
  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Sandpiles
Post by: Ashish on March 06, 2019, 01:44:37 am
Great bplus! Thanks for adding your contribution to this.
Text Only | Text with Attachments