Rosetta Code

Abelian sandpile model: Difference between revisions

Page Discussion

Abelian sandpile model (view source)

Revision as of 17:23, 23 March 2024

10,731 bytes added ,  1 month ago
m
→‎{{header|ALGOL 68}}: bug fix
 
(11 intermediate revisions by 8 users not shown)
Line 1:
{{task}}{{wikipedia|Abelian sandpile model}} [[Category:Cellular automata]]
<br>
Implement the '''Abelian sandpile model''' also known as '''Bak–Tang–Wiesenfeld model'''. Its history, mathematical definition and properties can be found under its [https://en.wikipedia.org/wiki/Abelian_sandpile_model wikipedia article].
Line 69:
simulate(&grid)
 
V ppm = File(‘sand_pile.ppm’, ‘w’WRITE)
ppm.write_bytes(("P6\n#. #.\n255\n".format(grid.len, grid.len)).encode())
V colors = [[Byte(0), 0, 0],
Line 336:
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
</pre>
 
=={{header|ALGOL 68}}==
Using code from the [[Abelian sandpile model/Identity]] task.
<syntaxhighlight lang="algol68">
BEGIN # model Abelian sandpiles #
# returns TRUE if the sandpile s is stable, FALSE otherwise #
OP STABLE = ( [,]INT s )BOOL:
BEGIN
BOOL result := TRUE;
FOR i FROM 1 LWB s TO 1 UPB s WHILE result DO
FOR j FROM 2 LWB s TO 2 UPB s WHILE result := s[ i, j ] < 4 DO SKIP OD
OD;
result
END # STABLE # ;
# returns the sandpile s after avalanches #
OP AVALANCHE = ( [,]INT s )[,]INT:
BEGIN
[ 1 : 1 UPB s, 1 : 2 UPB s ]INT result := s[ AT 1, AT 1 ];
WHILE BOOL had avalanche := FALSE;
FOR i TO 1 UPB s DO
FOR j TO 2 UPB s DO
IF result[ i, j ] >= 4 THEN
# unstable pile #
had avalanche := TRUE;
result[ i, j ] -:= 4;
IF i > 1 THEN result[ i - 1, j ] +:= 1 FI;
IF i < 1 UPB s THEN result[ i + 1, j ] +:= 1 FI;
IF j > 1 THEN result[ i, j - 1 ] +:= 1 FI;
IF j < 2 UPB s THEN result[ i, j + 1 ] +:= 1 FI
FI
OD
OD;
had avalanche
DO SKIP OD;
result
END # AVALANCHE # ;
# returns the maximum element of s #
OP MAX = ( [,]INT s )INT:
BEGIN
INT result := s[ 1 LWB s, 2 LWB s ];
FOR i FROM 1 LWB s TO 1 UPB s DO
FOR j FROM 2 LWB s TO 2 UPB s DO
IF s[ i, j ] > result THEN result := s[ i, j ] FI
OD
OD;
result
END # MAX # ;
# prints the sandpile s #
PROC show sandpile = ( STRING title, [,]INT s )VOID:
BEGIN
print( ( title, newline ) );
IF 1 UPB s >= 1 LWB s AND 2 UPB s >= 2 LWB s THEN
# non-empty sandpile #
INT width := 1; # find tthe width needed for each element #
INT v := MAX s;
WHILE v > 9 DO
v OVERAB 10;
width +:= 1
OD;
FOR i TO 1 UPB s DO
FOR j TO 2 UPB s DO
print( ( " ", whole( s[ i, j ], - width ) ) )
OD;
print( ( newline ) )
OD
FI
END # show sandpile # ;
# printys a sandpile before and after the avalanches #
PROC show sandpile before and after = ( [,]INT s )VOID:
BEGIN
[ 1 LWB s : 1 UPB s, 2 LWB s : 2 UPB s ]INT t := s;
show sandpile( "before: ", t );
WHILE NOT STABLE t DO
t := AVALANCHE t
OD;
show sandpile( "after: ", t );
print( ( newline ) )
END # show sandpile before and after # ;
# task test case #
[,]INT s1 = ( ( 0, 0, 0, 0, 0 )
, ( 0, 0, 0, 0, 0 )
, ( 0, 0, 16, 0, 0 )
, ( 0, 0, 0, 0, 0 )
, ( 0, 0, 0, 0, 0 )
);
show sandpile before and after( s1 );
# test case from 11l, C, etc. #
[ 1 : 10, 1 : 10 ]INT s2;
FOR i FROM 1 LWB s2 TO 1 UPB s2 DO
FOR j FROM 2 LWB s2 TO 2 UPB s2 DO
s2[ i, j ] := 0
OD
OD;
s2[ 6, 6 ] := 64;
show sandpile before and after( s2 )
END
</syntaxhighlight>
{{out}}
<pre>
before:
0 0 0 0 0
0 0 0 0 0
0 0 16 0 0
0 0 0 0 0
0 0 0 0 0
after:
0 0 1 0 0
0 2 1 2 0
1 1 0 1 1
0 2 1 2 0
0 0 1 0 0
 
before:
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 64 0 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0
after:
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 1 2 1 0 0 0
0 0 0 2 2 2 2 2 0 0
0 0 1 2 2 2 2 2 1 0
0 0 2 2 2 0 2 2 2 0
0 0 1 2 2 2 2 2 1 0
0 0 0 2 2 2 2 2 0 0
0 0 0 0 1 2 1 0 0 0
0 0 0 0 0 0 0 0 0 0
</pre>
 
Line 1,534 ⟶ 1,669:
HandleEvents
</syntaxhighlight>
[[File:AbelianSandpileModelAbeliaSandpileModelFB.png]]
 
=={{header|Go}}==
Line 2,389 ⟶ 2,524:
000001222100000
000000000000000</pre>
 
=={{header|MiniScript}}==
For use with the [http://miniscript.org/MiniMicro Mini Micro].
<syntaxhighlight lang="miniscript">
colors = [color.black, color.yellow, color.orange,
color.brown, color.red, color.fuchsia,
color.purple, color.blue, color.navy]
 
rows = 48; rowRange = range(0, rows-1)
cols = 72; colRange = range(0, cols-1)
particlesOfSand = rows * cols
divBase = particlesOfSand / (colors.len - 4)
deltas = [[0,-1],[-1, 0], [1, 0],[0, 1]]
 
displayGrid = function(grid, td)
for y in globals.rowRange
for x in globals.colRange
colorIx = grid[y][x]
// determine the rest of the colors if > 3 by division
if colorIx > 3 then colorIx = (colorIx - 3) / divBase + 4
td.setCell x,y, colorIx
end for
end for
end function
 
clear
 
// Prepare a tile display
// Generate image used for the tiles from the defined above.
// The colors are to indicate height of a sand pile.
img = Image.create(colors.len, 1);
for i in range(0, colors.len - 1)
img.setPixel(i, 0, colors[i])
end for
 
grid = []
for y in rowRange
row = []
for x in colRange
row.push(0)
end for
grid.push(row)
end for
 
grid[rows/2][cols/2] = particlesOfSand
 
display(4).mode = displayMode.tile
td = display(4)
td.cellSize = 640/48 // size of cells on screen
td.extent = [cols, rows]
td.overlap = 0 // adds a small gap between cells
td.tileSet = img; td.tileSetTileSize = 1
td.clear 0
 
toTopple = []
for y in rowRange
for x in colRange
if grid[y][x] > 3 and toTopple.indexOf([x,y]) == null then toTopple.push([x,y])
end for
end for
tt = time
while toTopple.len > 0
nextGen = []
for cell in toTopple
x = cell[0]; y = cell[1]
grid[y][x] -= 4
for delta in deltas
x1 = (x + delta[0]) % cols; y1 = (y + delta[1]) % rows
grid[y1][x1] += 1
end for
end for
for y in rowRange
for x in colRange
if grid[y][x] > 3 and nextGen.indexOf([x,y]) == null then nextGen.push([x,y])
end for
end for
toTopple = nextGen
displayGrid(grid, td)
end while
key.get()
</syntaxhighlight>
[[File:Miniscript_abelian_sandpille.png|800px|thumb|center|Image for 3456 particles grid 48*72]]
 
=={{header|Nim}}==
Line 3,025 ⟶ 3,242:
<span style="color: #000000;">main</span><span style="color: #0000FF;">()</span>
<!--</syntaxhighlight>-->
 
=={{header|PicoLisp}}==
<syntaxhighlight lang="picolisp">
(load "@lib/simul.l")
(symbols 'simul 'pico)
(de sandpile (A B)
(let
(Grid (grid A A)
Size (/ (inc A) 2)
Center (get Grid Size Size)
Done T )
(for G Grid
(for This G
(=: V 0) ) )
(with Center
(=: V B)
(while Done
(off Done)
(for G Grid
(for This G
(when (>= (: V) 4)
(=: V (- (: V) 4))
(on Done)
(mapc
'((Dir)
(with (Dir This) (=: V (inc (: V)))) )
'(north south west east) ) ) ) ) ) )
(disp Grid 0
'((This) (if (: V) (pack " " @ " ") " ")) ) ) )
(sandpile 10 64)
</syntaxhighlight>
 
{{out}}
<pre>
+---+---+---+---+---+---+---+---+---+---+
10 | 0 0 0 0 0 0 0 0 0 0 |
+ + + + + + + + + + +
9 | 0 0 0 0 0 0 0 0 0 0 |
+ + + + + + + + + + +
8 | 0 0 0 1 2 1 0 0 0 0 |
+ + + + + + + + + + +
7 | 0 0 2 2 2 2 2 0 0 0 |
+ + + + + + + + + + +
6 | 0 1 2 2 2 2 2 1 0 0 |
+ + + + + + + + + + +
5 | 0 2 2 2 0 2 2 2 0 0 |
+ + + + + + + + + + +
4 | 0 1 2 2 2 2 2 1 0 0 |
+ + + + + + + + + + +
3 | 0 0 2 2 2 2 2 0 0 0 |
+ + + + + + + + + + +
2 | 0 0 0 1 2 1 0 0 0 0 |
+ + + + + + + + + + +
1 | 0 0 0 0 0 0 0 0 0 0 |
+---+---+---+---+---+---+---+---+---+---+
a b c d e f g h i j
</pre>
 
=={{header|Python}}==
Line 3,303 ⟶ 3,577:
## 0 0 0 0 0 0 0 0 0
</syntaxhighlight>
 
=={{header|R}}==
<syntaxhighlight lang="R" line>
# Return (x,y) index from a grid from an index in a list based on the grid size
pos_to_index <- function(n) {
f1 <- n/gridsize
col <- ifelse(n%%gridsize == 0, f1,as.integer(f1)+1)
row <- n - ((col-1)*gridsize)
list(row=row,col=col)
}
 
# Return adjacent indexes (north, east, south, west)
adjacent_indexes <- function(r,c) {
rup <- r - 1
rdn <- ifelse(r == gridsize,0,r + 1)
cleft <- c - 1
cright <- ifelse(c==gridsize,0,c+1)
list(up=c(rup,c),right=c(r,cright),left=c(r,cleft),down=c(rdn,c))
}
 
# Generate Abelian pattern
abelian <- function(gridsize,sand) {
mat_ <- matrix(rep(0,gridsize^2),gridsize)
midv <- as.integer(gridsize/2) + 1
mat_[midv,midv] <- sand
cat("Before\n")
print(mat_)
 
while(T) {
cnt <- cnt + 1
tgt <- which(mat_ >= 4)
if (length(tgt) == 0) break
pos <- pos_to_index(tgt[1])
idxes <- adjacent_indexes(pos$row,pos$col)
mat_[pos$row,pos$col] <- mat_[pos$row,pos$col] - 4
 
for (i in idxes) if (0 %in% i == F) mat_[i[1],i[2]] <- mat_[i[1],i[2]] +1
}
cat("After\n")
print(mat_)
}
 
# Main
 
abelian(10,64)
</syntaxhighlight>
 
'''Output:'''
<pre>
Before
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 0 0 0 0 0 0 0 0 0
[2,] 0 0 0 0 0 0 0 0 0 0
[3,] 0 0 0 0 0 0 0 0 0 0
[4,] 0 0 0 0 0 0 0 0 0 0
[5,] 0 0 0 0 0 0 0 0 0 0
[6,] 0 0 0 0 0 64 0 0 0 0
[7,] 0 0 0 0 0 0 0 0 0 0
[8,] 0 0 0 0 0 0 0 0 0 0
[9,] 0 0 0 0 0 0 0 0 0 0
[10,] 0 0 0 0 0 0 0 0 0 0
After
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 0 0 0 0 0 0 0 0 0
[2,] 0 0 0 0 0 0 0 0 0 0
[3,] 0 0 0 0 1 2 1 0 0 0
[4,] 0 0 0 2 2 2 2 2 0 0
[5,] 0 0 1 2 2 2 2 2 1 0
[6,] 0 0 2 2 2 0 2 2 2 0
[7,] 0 0 1 2 2 2 2 2 1 0
[8,] 0 0 0 2 2 2 2 2 0 0
[9,] 0 0 0 0 1 2 1 0 0 0
[10,] 0 0 0 0 0 0 0 0 0 0
</pre>
 
=={{header|Raku}}==
Line 4,075 ⟶ 4,423:
=={{header|Wren}}==
{{libheader|Wren-fmt}}
<syntaxhighlight lang="ecmascriptwren">import "./fmt" for Fmt
 
class Sandpile {
Tigerofdarkness
3,028

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/345975...362492"