simulating earthquakes, avalanches and other self-critical phenomena
- To: mathgroup at yoda.physics.unc.edu
- Subject: simulating earthquakes, avalanches and other self-critical phenomena
- From: gaylord at ux1.cso.uiuc.edu
- Date: Thu, 6 Aug 1992 07:11:05 -0500
below is a 'functional' program [6 anonymous functions and higher order
functions] for a cellular automaton simulation of earthquakes, mudslides,
avalanches and other 'self-critical' phenomena. The full article (with
text) will be published in my column "Simulating Experiences: Excursions in
Programming" in "Mathematica in Education", an outstanding (and
inexpensive) newsletter [contact Paul wellin at wellin at Sonoma.edu for
subscription details].
btw - if you use this program together with my spreading program (posted
earlier), you can simulate California (earthquakes, forest fires and
mudslides).
=================================
Avalanches, Earthquakes, Sandpiles and Universal Self-Criticality
-------------------------
References:
1. "Catastrophes and Self-Organized Criticality", Per Bak, Computers
in Physics, 5(July/Aug),430-433 (1991).
2. "Self-Organized Criticality", Per Bak and Kan Chen, Scientific American,
264(1), 46-53 (1991)
--------------------------
The rule:
any site with a 'threshold' value of 4 or higher has (a) its value reduced
by 4 and (b) the values of its four nearest-neighbor sites incremented by
1.
The play:
the game is played on a square lattice with absorbing boundary conditions.
the initial configuration of the board is a matrix of randomly selected
integers bewteen 0 and 3.
a randomly selected site has its value incremented by 1.
at each time step,the game board is examined by the rules to determine the
configuration of the next generation.
the game proceeds until none of the sites have values greater than 3.
-------------------
<<Graphics3D.m
avalanches[s_Integer] :=
Module[{},
initconfig = Table[Random[Integer,{0,3}],{s},{s}];
initconfig[[Random[Integer,{1,s}],
Random[Integer,{1,s}]]] = 4;
absorbingBC =
(Prepend[Append[Map[Prepend[Append[#,0],0]&,#],
Table[0,{Length[#]+2}]],Table[0,{Length[#]+2}]])&;
topples = (Map[(If[#>3,#-4,#])&,#,{2}])&;
nbHgts = (Count[Flatten[#][[{2,4,6,8}]],4|5|6|7])&;
increments =
(Map[nbHgts,Partition[absorbingBC[#],{3,3},{1,1}],{2}])&;
frames =
FixedPointList[(topples[#]+increments[#])&,initconfig];
Do[BarChart3D[frames[[i]],
PlotRange->{{0,s+1},{0,s+1},{0,7}}],{i,Length[frames]}]
]
=================================
note - you might want to modify the Do loop to something like
If[Length[frames] > m, Do[BarChart3D[...] ] ]
so that the graphics are only created for animations consisting of at least
m cells.
richard j. gaylord, university of illinois, gaylord at ux1.cso.uiuc.edu
"if you're not programming functionally, then you must be programming
dysfunctionally"