Abelian sandpile model/Identity: Difference between revisions

=={{header|Mathematica}}/{{header|Wolfram Language}}==

<lang Mathematica>ClearAll[sp]

sp[s_List] + sp[n_Integer] ^:= sp[s] + sp[ConstantArray[n, Dimensions[s]]]

sp[s_List] + sp[t_List] ^:= Module[{dim, r, tmp, neighbours}, dim = Dimensions[s];

r = s + t;

While[Max[r] > 3,

r = ArrayPad[r, 1, 0];

tmp = Quotient[r, 4];

r -= 4 tmp;

r += RotateLeft[tmp, {0, 1}] + RotateLeft[tmp, {1, 0}] +

RotateLeft[tmp, {0, -1}] + RotateLeft[tmp, {-1, 0}];

r = ArrayPad[r, -1];

];

sp[r]

]

Format[x_sp] := Grid[x[[1]]]

s1 = sp[{{1, 2, 0}, {2, 1, 1}, {0, 1, 3}}];

s2 = sp[{{2, 1, 3}, {1, 0, 1}, {0, 1, 0}}];

s3 = sp[ConstantArray[3, {3, 3}]];

s3id = sp[{{2, 1, 2}, {1, 0, 1}, {2, 1, 2}}];

s1 + s2

s2 + s1

sp[{{4, 3, 3}, {3, 1, 2}, {0, 2, 3}}] + sp[0]

s3 + s3id === s3

s3id + s3id === s3id</lang>

{{out}}

<pre>3 3 3

3 1 2

0 2 3

3 3 3

3 1 2

0 2 3

2 1 0

0 3 3

1 2 3

True

True</pre>