# Abelian sandpile

I am trying to programm the Abelian sandpile model in VisualBasic. Also, here is a youtube video made by Numberphile about the very same topic.

Here is a picture ($2^{20}$ grains of sand) I made with my programm:

The current version workes fine - for now.

However, with large amounts of sand the calculation takes a very long time, and I wonder: Is there a possibility of speeding the code up?

To be fair, I am mostly self-taught in VB, so my code is likely to be ugly.

I'd be happy if you could take a look at my code and tell me, where I can make improvements. Thanks!

## Variables - Deklaration

Dim WDTH As Integer = 1000
Dim HGHT As Integer = 1000
Dim Array1(WDTH, HGHT) As Integer
Dim Done As Boolean
Dim Temp1 As Integer = 0
Dim Temp2 As Integer = 0


## Calculation

The first thing I do is resetting the array to 0.

For y As Integer = 0 To HGHT
For x As Integer = 0 To WDTH
Array1(x, y) = 0
Next
Next


The sand is placed on the grid:

Array1(500, 500) = 2 ^ 20


Then the calculation happens:

    Done = False
Do
Done = True
For y As Integer = 0 To HGHT
For x As Integer = 0 To WDTH
If Array1(x, y) >= 4 Then
Done = False
Temp1 = Array1(x, y) Mod 4
Temp2 = (Array1(x, y) - Temp1) / 4
Array1(x, y) = Temp1
Array1(x + 1, y) += Temp2
Array1(x - 1, y) += Temp2
Array1(x, y + 1) += Temp2
Array1(x, y - 1) += Temp2
End If
Next
Next
Loop Until Done = True


This describes the toppling of the sand. I go through the entire array, check if a sandpile needs to topple, I do that if needed, and go on. Once I have run through the entire array and nothing has happend, I know I am done.

However, this is very time consuming as I am checking a lot of cells that don't even have sand on them, and going through an 1000x1000 array 95175 times (this is the time it takes to topple $2^{20}$ sand grains) takes a lot of time.

This is actually already an improved version, I tried a recursive one too, but that didn't work.

So, the complete code is:

Dim WDTH As Integer = 1000
Dim HGHT As Integer = 1000
Dim Array1(WDTH, HGHT) As Integer
Dim Done As Boolean
Dim Temp1 As Integer = 0
Dim Temp2 As Integer = 0
Dim BGW As New System.ComponentModel.BackgroundWorker

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If Not BGW.IsBusy Then
BGW.RunWorkerAsync()
Button1.Enabled = False
End If
End Sub

Private Sub BGW_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BGW.DoWork
For y As Integer = 0 To HGHT
For x As Integer = 0 To WDTH
Array1(x, y) = 0
Next
Next

Array1(CInt(WDTH / 2), CInt(HGHTY / 2)) = 2 ^ 20

Done = False
Dim Iterationen As Integer = 0

Do
Done = True
Iterationen += 1
For y As Integer = 0 To HGHT
For x As Integer = 0 To WDTH
If Array1(x, y) >= 4 Then
Done = False
Temp1 = Array1(x, y) Mod 4
Temp2 = (Array1(x, y) - Temp1) / 4
Array1(x, y) = Temp1
Array1(x + 1, y) += Temp2
Array1(x - 1, y) += Temp2
Array1(x, y + 1) += Temp2
Array1(x, y - 1) += Temp2
End If
Next
Next

If BGW.CancellationPending Then
e.Cancel = True
Exit Sub
End If

Loop Until Done = True

Dim BMP As New Bitmap(WDTH, HGHT)

For y As Integer = 0 To HGHT - 1
For x As Integer = 0 To WDTH - 1
Select Case Array1(x, y)
Case 0 : BMP.SetPixel(x, y, Color.White)
Case 1 : BMP.SetPixel(x, y, Color.Green)
Case 2 : BMP.SetPixel(x, y, Color.Red)
Case 3 : BMP.SetPixel(x, y, Color.Blue)
End Select
Next
Next

PictureBox1.BackgroundImage = BMP

Beep()
End Sub

Private Sub BGW_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BGW.RunWorkerCompleted
Button1.Enabled = True
End Sub

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
PictureBox1.Width = WDTH
PictureBox1.Height = HGHT
End Sub


I tried reducing this as much as possible. The GUI contains a button named "Button1" and a picture box named "PictureBox1".

## This section contains a failed try. Please ignore it.

If you like to know, here is the recursive one:

## Calling the recursive function

ToppleSand(500, 500)


## The function itself

 Private Sub ToppleSand(ByVal x As Integer, ByVal y As Integer)
If Array1(x, y) >= 4 Then
Temp1 = Array1(x, y)
Array1(x, y) = Temp1 Mod 4
Temp1 = (Temp1 - (Temp1 Mod 4)) / 4
Array1(x + 1, y) += Temp1
Array1(x - 1, y) += Temp1
Array1(x, y + 1) += Temp1
Array1(x, y - 1) += Temp1
ToppleSand(x + 1, y)
ToppleSand(x - 1, y)
ToppleSand(x, y + 1)
ToppleSand(x, y - 1)
End If
End Sub


This got me a stackoverflow exeption, so I discarded this try.

• "Can you show the whole method you are using ?" - So, you mean the entire programm? With graphics and GUI and everything? Commented Jun 20, 2017 at 11:37
• Don't be confused by the ´ToppleSand()´ method. That was a failed try. I'll edit it to make it more clear. Commented Jun 20, 2017 at 11:46
• Will review it tomorrow if no one reviewed it. Commented Jun 20, 2017 at 12:21

## Option Strict

Not setting Option Strict to On can lead to problems because it enables you to code without strictly typing. See: https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/statements/option-strict-statement

It can e.g lead to loss in precision or to a runtime exception.

## Naming and scope of variables

Dim Array1(WDTH, HGHT) As Integer
Dim Done As Boolean
Dim Temp1 As Integer = 0
Dim Temp2 As Integer = 0


These variables should be declared inside the BGW_DoWork() method. As a rule of thumb, one should declare variables as near to their usage as possible and should be scoped as thightly as possible.

While we are at the variables let's talk about naming.
Neither methods, nor parameters, variables, fields should be named using abbreviations. It makes your code harder to read if you first need to figure out in your head what e.g HGHT means. Writing code should be done in a way that enables the reader to grasp at first glance what the code is doing.

Based on the .NET Naming Guidelines variables/fields should be named using camelCase casing. Although VB isn't case sensitive you will do yourself a favour if you stick to the naming guidelines for each language you learn.

If a variable isn't meant to be changed by code you should make it a const, e.g your WDTH and HGHT.

## Performance

• By declaring Array1 inside BGW_DoWork() you won't need to set the array items to 0.

• Instead of SetPixel() you could use Bitmap.LockBits() like shown here but this will only save 1 second for a 1000x1000 bitmap.

• The calculation of the values when Array1(x, y) >= 4 can be simplified by using integer division like so

Done = False
Temp2 = Array1(x, y) \ 4
Array1(x, y) = Array1(x, y) Mod 4
Array1(x + 1, y) += Temp2
Array1(x - 1, y) += Temp2
Array1(x, y + 1) += Temp2
Array1(x, y - 1) += Temp2


This saves around 20% of execution time which results in 984 seconds for 1000x1000.

• By using a 1d array the performace can be improved some more. Please note that the created image by the provided code looks good for 1000x1000 but not for a 100x100 (couldn't sort it out, will be glad if someone can point the problem).

Private Function StabilizeGrains(piles() As Integer, gridWidth As Integer, gridHeight As Integer) As Boolean

Dim allPilesAreStable As Boolean = True
Dim width As Integer = 0
For y As Integer = 0 To gridHeight - 1
For x As Integer = 0 To gridWidth - 1

Dim index As Integer = x + width
Dim currentvalue As Integer = piles(index)

If currentvalue > 3 Then

allPilesAreStable = False
Dim quarter As Integer = currentvalue \ 4

piles(index) = currentvalue Mod 4
If (x < gridWidth) Then
piles(index + 1) += quarter
End If
If (x > 0) Then
piles(index - 1) += quarter
End If
If (y < gridHeight - 1) Then
piles(index + gridWidth) += quarter
End If
If (y > 0) Then
piles(index - gridWidth) += quarter
End If

End If

Next
width += WDTH
Next
Return allPilesAreStable
End Function


This method is called in the BGW_DoWork() method which looks like so

Private Sub BGW_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BGW.DoWork

Dim piles(WDTH * HGHT) As Integer

Dim sandPlacingIndex As Integer = (WDTH * HGHT + WDTH) \ 2

piles(sandPlacingIndex) = CInt(2 ^ 20)

Dim Iterationen As Integer = 0

Do
Iterationen += 1

If BGW.CancellationPending Then
e.Cancel = True
Exit Sub
End If

Loop Until StabilizeGrains(piles, WDTH, HGHT)

PictureBox1.BackgroundImage = CreateBitmap(piles, WDTH, HGHT)

End Sub


The creation of the resulting image is extracted to its own method like so

Private Function CreateBitmap(piles() As Integer, gridWidth As Integer, gridHeight As Integer) As Bitmap
Dim bmp As New Bitmap(WDTH, HGHT)

Dim width As Integer = 0
For y As Integer = 0 To gridHeight - 1

For x As Integer = 0 To gridWidth - 1
Select Case piles(x + width)
Case 0 : bmp.SetPixel(x, y, Color.White)
Case 1 : bmp.SetPixel(x, y, Color.Green)
Case 2 : bmp.SetPixel(x, y, Color.Red)
Case 3 : bmp.SetPixel(x, y, Color.Blue)
End Select
Next
width += gridWidth
Next
Return bmp
End Function


These changes will lead to a processing time of 229 seconds.

Please note that measureing the times where done using poor man benchmarking aka StopWatch. So don't take them granted

## Small Bug

If e.g WDTH = 100 and HGHT = 100 your code will throw an IndexOutOfRangeException. If you want to prevent this you should add some if statements to check the values of x and y. This doesn't seem to be a problem with WDTH = 1000 and HGHT = 1000.

• According to the pattern the variable name Done is wrong, it should be Dn :-) Commented Jun 21, 2017 at 16:00
• This might be the reason why the picture doesn't look good if the array is 100x100. You wrote: Dim sandPlacingIndex As Integer = (WDTH * HGHT + WDTH) \ 2 but this doesn't quite center the sand pile. I guess this should be Dim sandPlacingIndex As Integer = (WDTH * HGHT) \ 2. Another idea: By letting the x and y range not from 0 but from 1 up to gridHeight - 1 or gridWidth - 1, this should remove the out of range exeption and does not requiere the additional If-statements. Those were some ideas I had. But now I want to thank you for your very detailed answer! :D Commented Jun 22, 2017 at 11:21
• Brain failed. The correct formula should beDim sandPlacingIndex As Integer = WDTH * (HGHT \ 2) + WDTH \ 2 Commented Jun 22, 2017 at 11:56
• Thats exactly the same as I have written :-( Commented Jun 22, 2017 at 12:00
• Weird. Hmmm... Do you mean by "doesn't look good" the fact that the picture is quite different from a cropped version of the 1000x1000 picture? If so: This normal and expected for an array too small. Commented Jun 22, 2017 at 12:30