(***********************************************************************
Mathematica-Compatible Notebook
This notebook can be used on any computer system with Mathematica 3.0,
MathReader 3.0, or any compatible application. The data for the notebook
starts with the line of stars above.
To get the notebook into a Mathematica-compatible application, do one of
the following:
* Save the data starting with the line of stars above into a file
with a name ending in .nb, then open the file inside the application;
* Copy the data starting with the line of stars above to the
clipboard, then use the Paste menu command inside the application.
Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode. Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).
NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing the
word CacheID, otherwise Mathematica-compatible applications may try to
use invalid cache data.
For more information on notebooks and Mathematica-compatible
applications, contact Wolfram Research:
web: http://www.wolfram.com
email: info@wolfram.com
phone: +1-217-398-0700 (U.S.)
Notebook reader applications are available free of charge from
Wolfram Research.
***********************************************************************)
(*CacheID: 232*)
(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[ 25406, 732]*)
(*NotebookOutlinePosition[ 26461, 768]*)
(* CellTagsIndexPosition[ 26417, 764]*)
(*WindowFrame->Normal*)
Notebook[{
Cell[CellGroupData[{Cell[TextData[{
StyleBox[" ",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontSize->14],
StyleBox["Simulating Experiences: Excursions in Programming",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontSize->24]
}], "Title",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontSize->14],
Cell[TextData["``Forest Fires and Reforestation''"], "Subtitle",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontSize->14],
Cell[TextData[{
StyleBox["Mathematica in Education",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox["\nVol.3 No.2\nSpring 1994\n(c) TELOS/Springer-Verlag\n\n",
Evaluatable->False,
AspectRatioFixed->True]
}], "Subtitle",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
" by\n Richard J. Gaylord\nDepartment of Materials Science\nUniversity of \
Illinois at Urbana-Champaign\ngaylord@ux1.cso.uiuc.edu\n\nand\n\nKazume \
Nishidate\nDepartment of Electrical and Electronic Engineering\nIwate \
University, Faculty of Engineering\nMorioka 020 JAPAN\n\
nisidate@wriron1.s.kanazawa-u.ac.jp"], "Subsubtitle",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData["edited by Richard J. Gaylord"], "Subsubtitle",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData[" Introduction"], "Section",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontSize->14],
Cell[TextData[
"Turbulent cascading has been suggested as the underlying cause of a wide \
variety of phenomena, including geological upheavals (eg., volcanic eruptions \
and earthquakes), species extinction during evolution, and fluid turbulence. \
A simple one-dimensional probabilistic cellular automaton, known as the \
forest fire model, displays this behavior."], "Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[CellGroupData[{Cell[TextData[" The Forest Fire CA"], "Section",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontSize->14],
Cell[CellGroupData[{Cell[TextData[" System"], "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"The forest fire CA employs a one-dimensional lattice of length n, with \
periodic boundary conditions. Lattice sites may have a value of 0, 1 or 2, \
where 0 represents an empty site (or hole), 1 represents a healthy tree (or \
tree), and 2 represents a burning tree. A forest is a set of contiguous sites \
(ie., a connected segment) with value 1 or 2. A forest preserve consists of \
forests separated by gaps (or deserts) consisting of clusters of connected \
holes. The system evolves in a specified number of time steps, in each of \
which entire forests of trees can catch fire and burn down and trees can \
sprout on individual empty sites. "], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"(Note: having all of the trees in a forest burn down in a single time step \
while trees grows independently of one another provides a separation between \
the time scales for the processes of deforestation and reforestation). "],
"Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[CellGroupData[{Cell[TextData[" Algorithm"], "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["Statement and Implementation"], "Subsubsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"(1) A forest preserve of length n, consisting of emtpy sites and tree sites \
is created using"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData["forestPreserve = Table[Random[Integer], {n}]"], "Input",
AspectRatioFixed->True],
Cell[TextData[
"All of the sites in the forest preserve are updated in each time step, \
according to the following sequence of steps:"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"(2a) Trees catch fire with probability f and empty sites sprout trees with \
probability, p, using a set of transformation rules to turn 0's into 1's with \
probability p, and 1's into 2's with probability, f"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"treeGrowIgnite = forestPreserve /. {0 :> Floor[1 + p - Random[]], 1 :> \
Floor[2 + f - Random[]]}"], "Input",
AspectRatioFixed->True],
Cell[TextData[
"(2b) All tree sites adjacent to an ignited tree site (ie., trees in the same \
forest ) ignite. This accomplished using the repeated application of a set of \
transformation rules"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"forestIgnite = treeGrowIgnite //. {{a___, 2, 1, b___} -> {a, 2, 2, b}, \n \
{a___, 1, 2, b___} -> {a, 2, \
2, b},\n {2, c___, 1} -> \
{2, c, 2}, \n {1, c___, \
2} -> {2, c, 2}}"], "Input",
AspectRatioFixed->True],
Cell[TextData[
"(note: The first two transformation rules change sequences in the list \
having the form .., 1, 2,.. and .., 2, 1, .. to .., 2, 2, .. . and the last \
two transformation rules implement periodic boundary conditions by treating \
trees at each end of the system as belonging to the same forest."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData["(2c) All ignited trees burn down. "], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData["forestNew = forestIgnite /. 2 -> 0"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"The sequence of steps 2a-c can be combined in an anonymous function which \
can be applied to any forest preserve configuration"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"pyro = \n (treeGrowIgnite = # /. {0 :> Floor[1 + p - Random[]], \
1 :> Floor[2 + f - Random[]]};\n forestIgnite = treeGrowIgnite \
//. {{2, c___, 1} -> {2, c, 2},\n \
{1, c___, 2} -> {2, c, 2},\n \
{a___, 2, 1, b___} -> {a, 2, 2, \
b},\n \
{a___, 1, 2, b___} -> {a, 2, 2, b}};\n forestNew = forestIgnite \
/. 2 -> 0)&"], "Input",
AspectRatioFixed->True],
Cell[TextData["where # represents the forest preserve configuration."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData["(3) Step 2 is repeated m times using"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData["NestList[pyro, forestPreserve, m] "], "Input",
AspectRatioFixed->True],
Cell[TextData["These pieces of code can be combined into a program. "], "Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]]}, Open]],
Cell[CellGroupData[{Cell[TextData["Program"], "Subsection",
Evaluatable->False,
PageBreakBelow->Automatic,
AspectRatioFixed->True],
Cell[TextData[
"smokeyTheBear[n_, p_, f_, m_] :=\n Module[{},\n \n \
forestPreserve = Table[Random[Integer], {n}];\n\n pyro = \n \
(treeGrowIgnite = #/.{0 :> Floor[1 + p - Random[]], 1 :> Floor[2 + f - \
Random[]]};\n forestIgnite = TreeGrowIgnite //. {{2, c___, 1} \
-> {2, c, 2},\n \
{1, c___, 2} -> {2, c, 2},\n \
{a___, 2, 1, b___} -> {a, 2, 2, b},\n \
{a___, 1, 2, \
b___} -> {a, 2, 2, b}};\n forestNew = forestIgnite /. 2 -> \
0)&;\n \n trees = NestList[pyro, forestPreserve, m] \n ]"],
"Input",
PageBreakBelow->True,
AspectRatioFixed->True]}, Open]]}, Open]],
Cell[CellGroupData[{Cell[TextData[" Distribution of Forests"], "Section",
Evaluatable->False,
PageBreakWithin->Automatic,
PageBreakBelow->Automatic,
AspectRatioFixed->True,
FontFamily->"Times",
FontSize->14],
Cell[TextData[
"It is useful to see the 'forest through the trees'. To identify the various \
forests in the forest preserve, a program which labels clusters on a \
one-dimensional lattice with reflecting boundary conditions can be written \
consisting of the following steps:"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"(1) The lattice sites in the lattice, lat, are updated using "], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData["clusterID[#, RotateLeft[#]]&[lat]"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData["where"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"clusterID[1, 0] := i++\nclusterID[1, 1] := i\nclusterID[0, b_] := 0 \n\
Attributes[clusterID] = Listable;"], "Input",
AspectRatioFixed->True],
Cell[TextData[
"where the two arguments of clusterID are the value of a cell and the value \
of its right nn. clusterID places an identifying label, i, on the sites in \
each cluster of contiguous sites. The initial value of i is 1 and increases \
by 1 for each successive cluster."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"(2) After clusterID has been applied to the lattice, all of the clusters \
have been correctly labelled with one exception: clusters occurring at the \
extreme ends of the lattice have been identified as different clusters when \
they should be treated as a single cluster. To correctly identify the sites \
in these two clusters as belonging to the same cluster, we can use the \
anonymous function "], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData[
"If[MatchQ[0, First[#] | Last[#]], #, # /. Last[#] -> 1]&"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData[
"\<\
If[MatchQ[0, First[#1] | Last[#1]], #1, #1 /. Last[#1] -> 1] &\
\>",
"\<\
If[MatchQ[0, First[#1] | Last[#1]], #1, #1 /. Last[#1] -> 1] &\
\>"],
"Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[TextData["These code fragments can be combined into a program."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"clusterLabel1D[lis_List] :=\n Module[{i = 1, clusterID, relabel},\n\n \
clusterID[1, 0] := i++;\n clusterID[1, 1] := i;\n clusterID[0, b_] := \
0;\n Attributes[clusterID] = Listable;\n \n result = clusterID[#, \
RotateLeft[#]]&[lis];\n \n If[MatchQ[0, First[#] | Last[#]], #, # /. \
Last[#] -> 1]&[result]\n ]"], "Input",
PageBreakAbove->False,
AspectRatioFixed->True],
Cell[TextData[
"The use of the clusterLabel1D function can be be illustrated with a simple \
forest preserve."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData[
"config = {1, 1, 0, 0, 1, 0, 1, 1, 1, 0, 1};\nlabelledForests = \
clusterLabel1D[config] "], "Input",
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{1, 1, 0, 0, 2, 0, 3, 3, 3, 0, 1}\
\>",
"\<\
{1, 1, 0, 0, 2, 0, 3, 3, 3, 0, 1}\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[TextData[
"Having identified the various forests in config, their size distribution can \
be determined as follows:"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"The sizes of the various forests in config is given by"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData[
"forestSizes = Map[Count[labelledForests,#]&,\n \
Rest[Union[labelledForests]] ]"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{3, 1, 3}\
\>", "\<\
{3, 1, 3}\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[TextData[
"The result indicate that the forests in config have 3, 1, and 3 trees, \
respectively. "], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"(note: While forestSizes gives the sizes of forests in the order in which \
they occur in the forest preserve, it does not give the sizes of the deserts \
lying between the forests. This can be determined using "], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData[
"Map[({#, 1})&, config] //.\n{u___, {v_, r_}, {v_, s_}, w___} -> {u, {v, r + \
s}, w} /. {{y_, t_}, z___,{y_, u_}}->{{y, t + u}, z} "], "Input",
AspectRatioFixed->True],
Cell[OutputFormData[
"\<\
{{1, 3}, {0, 2}, {1, 1}, {0, 1}, {1, 3}, {0, 1}}\
\>",
"\<\
{{1, 3}, {0, 2}, {1, 1}, {0, 1}, {1, 3}, {0, 1}}\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[TextData[
"which indicates a sequence consisting of a three-tree forest, a two-site \
desert, a lone tree, a single empty site, a three-tree forest and an empty \
site).\n\nThe distribution of forest sizes is computed using forestSites with \
the frequency function"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"frequency[x_List] := Map[{#, Count[x, #]}&, Union[x]] "], "Input",
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["frequency[forestSizes] "], "Input",
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{{1, 1}, {3, 2}}\
\>",
"\<\
{{1, 1}, {3, 2}}\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[TextData[
"which indicates that config contains one lone tree and two 3-tree forests. \
"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"A graph of the forest size distribution can be made using ListPlot on the \
final list."], "Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[CellGroupData[{Cell[TextData[" Computer Simulation Projects"], "Section",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontSize->14],
Cell[TextData[{
StyleBox["1. ",
Evaluatable->False,
AspectRatioFixed->True,
FontWeight->"Bold"],
StyleBox[
"A two-dimensional version of the forest fire algorithm has recently been \
presented (see Physica A, vol. 204, pp.212-229 (1994)) which appears to show \
a variety of interesting behaviors. The model is described as follows:",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"The sites of a square lattice with periodic boundary conditions are either: \
occupied by trees (ie., have a value 1), burning trees (ie., have a value 2) \
or are empty (ie., have a value 0). during a time step, all of the sites are \
updated acccording to the following rules:"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"(1) a tree becomes a burning tree with probability (1 - g) if at least one \
nn is burning.\n(2) a tree becomes a burning tree with probability f(1 - g) \
if no nn is burning.\n(3) a burning tree becomes an empty site.\n(4) an empty \
site becomes a tree with probability p."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"where there are three probability parameters: f is the lightning \
probability, g is the immunity, and p is the tree growth probability. "],
"Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"It has been found that for this model:\n (a) when f and g are zero, \
spiral-shaped fire fronts, reminiscent of the excitable media (see chapter \
10), form for small vaules of p. \n (b) when g = 0, a self-organized \
critical state (see chapter 8) occurs. \n (c) when f = 0, a \
percolation-like phase transition (see chapter 5) takes place at a critical \
value of g which depends on p. \n "], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"The spirals form when empty areas grow at the expense of forests as fire \
advances while forests grow into empty areas in the absense of fire, so the \
fire fronts and tree fronts wind around one another. The SOC state results \
when tree growth occurs more often than lightning and forests burn down \
faster than trees grow so that fires of all sizes occur. The percolation-like \
phase transition happens when there is a zero fire density. "], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
" \nImplement this algorithm in a CA and use it to create snapshots of the \
forest preserve showing these behaviors."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox["2.",
Evaluatable->False,
AspectRatioFixed->True,
FontWeight->"Bold"],
StyleBox[
" The average size of forests in the two-dimensional forest preserve is of \
interest. To determine this quantity, we can first identify the forests in \
the preserve and then measue their sizes.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
" The labeling procedure for the two-dimensional lattice having reflecting \
boundaries can be explained using a simple lattice as an example."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData[
"(lat = {{1,0,1,0,0},{0,1,0,1,0},{1,1,0,1,0},{1,0,0,0,1}})//MatrixForm"],
"Input",
AspectRatioFixed->True],
Cell[OutputFormData[
"\<\
MatrixForm[{{1, 0, 1, 0, 0}, {0, 1, 0, 1, 0}, {1, 1, 0, 1, 0},
{1, 0, 0, 0, 1}}]\
\>", "\<\
1 0 1 0 0
0 1 0 1 0
1 1 0 1 0
1 0 0 0 1\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[TextData[
"(1) The lattice sites at the 'northwest' (ie. top left) corners of the \
clusters are first labelled using "], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"clusterID[RotateRight[lat, {1, 0}], RotateRight[lat, {0, 1}], lat]"], "Input",\
AspectRatioFixed->True],
Cell[TextData["where"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"clusterCornerID[1, 0, 0] := i++;\nclusterCornerID[a_ , __] := a;\n\
Attributes[clusterCornerID] = Listable"], "Input",
AspectRatioFixed->True],
Cell[TextData[
"The three arguments of clusterCornerID are the value of a site, the nn above \
the site, and the value of the nn to the left of the site. \n\nUsing \
clusterCornerID with lat, we get"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData[
"i = 2;\nclusterCornerID[1,0, 0]:= i++;\nclusterCornerID[a_, __]:= a;\n\
Attributes[clusterCornerID] = Listable;\nlat = \
{{1,0,1,0,0},{0,1,0,1,0},{1,1,0,1,0},{1,0,0,0,1}};\n(cornerLabels = \
clusterCornerID[#, \n RotateRight[#,{1,0}],\n \
RotateRight[#,{0,1}]\n \
]&[lat])//MatrixForm"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData[
"\<\
MatrixForm[{{1, 0, 2, 0, 0}, {0, 3, 0, 4, 0}, {5, 1, 0, 1, 0},
{1, 0, 0, 0, 6}}]\
\>", "\<\
1 0 2 0 0
0 3 0 4 0
5 1 0 1 0
1 0 0 0 6\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[TextData[
"note: In performing the above labeling, the initial value of i was taken to \
be 2 (and as a result, cluster corner sites were numbered 2, 3, ...) because \
the value 1 was used to identify non-corner cluster sites. However, i = 1 can \
be used in the final clusterLabel2D program)."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"(2) Having labelled the sites at the corner of clusters, we next label the \
sites (those with value 1) that lie within clusters and we merge contiguous \
clusters . Both of these are accomplished with the following rules"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"reLabel[0, ___] := 0;\nreLabel[a_, b_, c_, d_, e_] := Max[a, b, c, d, e];\n\
Attributes[reLabel] = Listable;"], "Input",
AspectRatioFixed->True],
Cell[TextData[
"where the five arguments of reLabel are: the value of a site, the value of \
the nn above the site, the value of the nn to the left of the site, the \
value of the nn beneath the site and the value of the nn to the right of the \
site.Using FixedPoint to apply reLabel repeatedly to cornerLabels (which is \
the result of applying clusterCornerID to lat), until the cluster labels no \
longer change, we get"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData[
"reLabel[0, ___] := 0;\nreLabel[a_, b_, c_, d_, e_] := Max[a, b, c, d, e];\n\
Attributes[reLabel] = Listable;\nFixedPoint[reLabel[#,\n \
RotateRight[#,{1, 0}],\n RotateRight[#,{0, 1}],\n \
RotateRight[#,{-1,0}],\n RotateRight[#,{0,-1}]]&, \n\
cornerLabels]//MatrixForm"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData[
"\<\
MatrixForm[{{6, 0, 2, 0, 0}, {0, 6, 0, 4, 0}, {6, 6, 0, 4, 0},
{6, 0, 0, 0, 6}}]\
\>", "\<\
6 0 2 0 0
0 6 0 4 0
6 6 0 4 0
6 0 0 0 6\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[TextData[
"We can now combine these code fragments into a program."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"clusterLabel2D[lat_List]:=\n Module[{i=2},\n\n clusterCornerID[1,0, \
0]:= i++;\n clusterCornerID[a_, __]:= a;\n \
Attributes[clusterCornerID] = Listable;\n \n cornerLabels = \
clusterCornerID[#, RotateRight[#,{1,0}], RotateRight[#,{0,1}]]&[lat];\n\n \
reLabel[0, ___] := 0;\n reLabel[a_, b_, c_, d_, e_] := Max[a, b, c, \
d, e];\n Attributes[reLabel] = Listable;\n \n \
FixedPoint[reLabel[#, \n \
RotateRight[#,{1, 0}], \n \
RotateRight[#,{0, 1}], \n \
RotateRight[#,{-1,0}], \n \
RotateRight[#,{0,-1}]]&, cornerLabels]\n ]"], "Input",
AspectRatioFixed->True],
Cell[TextData[
"If desired, it is straightforward (see the relabelrules2 function in the \
clusterLabel program in Chapter 5) to relabel the identified clusters so that \
their numbering is sequential with no gaps. "], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"While the clusterLabel2D program is specifically designed for use with a \
lattice system having reflecting boundary conditions, it can be used with a \
lattice having absorbing boundary conditions by 'decorating' the lattice with \
rows and columns of 0's (the sandpile model program in Chapter 8 shows how \
to do this using the absorbBC function ). "], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"Compare the relative speeds of the clusterLabel2D program and the \
clusterLabel program in chapter 5 as function of the lattice size."], "Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[CellGroupData[{Cell[TextData[" General References"], "Section",
Evaluatable->False,
PageBreakAbove->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontSize->14],
Cell[TextData[
"Paczuski, Maya and Bak, Per. 1993 \"Theory of the one-dimensional \
forest-fire model\", Phys. Rev. E, 48, pp. R3214-R3216. "], "Text",
Evaluatable->False,
PageBreakAbove->False,
AspectRatioFixed->True],
Cell[TextData[
"Bak, Per and Paczuski, Maya. 1993 \"Why Nature is Complex\", Physics World, \
pp. 396-403."], "Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]]}, Open]]
},
FrontEndVersion->"Macintosh 3.0",
ScreenRectangle->{{0, 640}, {0, 460}},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{520, 365},
WindowMargins->{{44, Automatic}, {Automatic, 31}},
PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}},
ShowCellLabel->True,
ShowCellTags->False,
RenderingOptions->{"ObjectDithering"->True,
"RasterDithering"->False},
MacintoshSystemPageSetup->"\<\
AVU/IFiQKFD000000V:^/09R]g0000000OVaH097bCP0AP1Y06`0I@1^0642HZj`
0V:gT0000001nK500TO9>000000000000000009R[[0000000000000000000000
00000000000000000000000000000000\>"
]
(***********************************************************************
Cached data follows. If you edit this Notebook file directly, not using
Mathematica, you must remove the line containing CacheID at the top of
the file. The cache data will then be recreated when you save this file
from within Mathematica.
***********************************************************************)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[1731, 51, 386, 15, 70, "Title",
Evaluatable->False],
Cell[2120, 68, 151, 4, 70, "Subtitle",
Evaluatable->False],
Cell[2274, 74, 319, 10, 70, "Subtitle",
Evaluatable->False],
Cell[2596, 86, 396, 7, 70, "Subsubtitle",
Evaluatable->False],
Cell[2995, 95, 109, 2, 70, "Subsubtitle",
Evaluatable->False],
Cell[CellGroupData[{
Cell[3127, 99, 129, 4, 70, "Section",
Evaluatable->False],
Cell[3259, 105, 425, 7, 70, "Text",
Evaluatable->False]
}, Closed]],
Cell[CellGroupData[{
Cell[3716, 114, 135, 4, 70, "Section",
Evaluatable->False],
Cell[CellGroupData[{
Cell[3874, 120, 87, 2, 70, "Subsection",
Evaluatable->False],
Cell[3964, 124, 723, 11, 70, "Text",
Evaluatable->False],
Cell[4690, 137, 308, 6, 70, "Text",
Evaluatable->False]
}, Closed]],
Cell[CellGroupData[{
Cell[5030, 145, 90, 2, 70, "Subsection",
Evaluatable->False],
Cell[CellGroupData[{
Cell[5143, 149, 111, 2, 70, "Subsubsection",
Evaluatable->False],
Cell[5257, 153, 170, 4, 70, "Text",
Evaluatable->False],
Cell[5430, 159, 97, 1, 70, "Input"],
Cell[5530, 162, 193, 4, 70, "Text",
Evaluatable->False],
Cell[5726, 168, 283, 5, 70, "Text",
Evaluatable->False],
Cell[6012, 175, 151, 3, 70, "Input"],
Cell[6166, 180, 254, 5, 70, "Text",
Evaluatable->False],
Cell[6423, 187, 386, 6, 70, "Input"],
Cell[6812, 195, 368, 6, 70, "Text",
Evaluatable->False],
Cell[7183, 203, 108, 2, 70, "Text",
Evaluatable->False],
Cell[7294, 207, 108, 2, 70, "Text",
Evaluatable->False],
Cell[7405, 211, 202, 4, 70, "Text",
Evaluatable->False],
Cell[7610, 217, 615, 9, 70, "Input"],
Cell[8228, 228, 127, 2, 70, "Text",
Evaluatable->False],
Cell[8358, 232, 110, 2, 70, "Text",
Evaluatable->False],
Cell[8471, 236, 87, 1, 70, "Input"],
Cell[8561, 239, 127, 2, 70, "Text",
Evaluatable->False]
}, Closed]]
}, Open ]],
Cell[CellGroupData[{
Cell[8729, 243, 116, 3, 70, "Subsection",
Evaluatable->False,
PageBreakBelow->Automatic],
Cell[8848, 248, 844, 13, 70, "Input",
PageBreakBelow->True]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[9733, 263, 199, 6, 70, "Section",
Evaluatable->False,
PageBreakWithin->Automatic,
PageBreakBelow->Automatic],
Cell[9935, 271, 335, 6, 70, "Text",
Evaluatable->False],
Cell[10273, 279, 136, 3, 70, "Text",
Evaluatable->False],
Cell[10412, 284, 107, 2, 70, "Text",
Evaluatable->False],
Cell[10522, 288, 79, 2, 70, "Text",
Evaluatable->False],
Cell[10604, 292, 159, 3, 70, "Input"],
Cell[10766, 297, 342, 6, 70, "Text",
Evaluatable->False],
Cell[11111, 305, 475, 8, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[11609, 315, 110, 2, 70, "Input"],
Cell[11722, 319, 231, 9, 70, "Output",
Evaluatable->False]
}, Closed]],
Cell[11965, 330, 126, 2, 70, "Text",
Evaluatable->False],
Cell[12094, 334, 424, 7, 70, "Input",
PageBreakAbove->False],
Cell[12521, 343, 168, 4, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[12712, 349, 142, 3, 70, "Input"],
Cell[12857, 354, 169, 7, 70, "Output",
Evaluatable->False]
}, Closed]],
Cell[13038, 363, 179, 4, 70, "Text",
Evaluatable->False],
Cell[13220, 369, 129, 3, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[13372, 374, 150, 3, 70, "Input"],
Cell[13525, 379, 120, 6, 70, "Output",
Evaluatable->False]
}, Closed]],
Cell[13657, 387, 162, 4, 70, "Text",
Evaluatable->False],
Cell[13822, 393, 286, 5, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[14131, 400, 185, 3, 70, "Input"],
Cell[14319, 405, 200, 8, 70, "Output",
Evaluatable->False]
}, Closed]],
Cell[14531, 415, 329, 6, 70, "Text",
Evaluatable->False],
Cell[14863, 423, 108, 2, 70, "Input"],
Cell[CellGroupData[{
Cell[14994, 427, 76, 1, 70, "Input"],
Cell[15073, 430, 135, 7, 70, "Output",
Evaluatable->False]
}, Closed]],
Cell[15220, 439, 152, 4, 70, "Text",
Evaluatable->False],
Cell[15375, 445, 162, 4, 70, "Text",
Evaluatable->False]
}, Closed]],
Cell[CellGroupData[{
Cell[15569, 451, 145, 4, 70, "Section",
Evaluatable->False],
Cell[15717, 457, 465, 13, 70, "Text",
Evaluatable->False],
Cell[16185, 472, 355, 6, 70, "Text",
Evaluatable->False],
Cell[16543, 480, 350, 6, 70, "Text",
Evaluatable->False],
Cell[16896, 488, 215, 5, 70, "Text",
Evaluatable->False],
Cell[17114, 495, 470, 8, 70, "Text",
Evaluatable->False],
Cell[17587, 505, 519, 8, 70, "Text",
Evaluatable->False],
Cell[18109, 515, 191, 4, 70, "Text",
Evaluatable->False],
Cell[18303, 521, 434, 13, 70, "Text",
Evaluatable->False],
Cell[18740, 536, 216, 4, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[18979, 542, 126, 3, 70, "Input"],
Cell[19108, 547, 263, 15, 70, "Output",
Evaluatable->False]
}, Closed]],
Cell[19383, 564, 183, 4, 70, "Text",
Evaluatable->False],
Cell[19569, 570, 122, 3, 70, "Input"],
Cell[19694, 575, 79, 2, 70, "Text",
Evaluatable->False],
Cell[19776, 579, 160, 3, 70, "Input"],
Cell[19939, 584, 257, 5, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[20219, 591, 431, 7, 70, "Input"],
Cell[20653, 600, 263, 15, 70, "Output",
Evaluatable->False]
}, Closed]],
Cell[20928, 617, 359, 6, 70, "Text",
Evaluatable->False],
Cell[21290, 625, 296, 5, 70, "Text",
Evaluatable->False],
Cell[21589, 632, 162, 3, 70, "Input"],
Cell[21754, 637, 483, 8, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[22260, 647, 404, 6, 70, "Input"],
Cell[22667, 655, 263, 15, 70, "Output",
Evaluatable->False]
}, Closed]],
Cell[22942, 672, 130, 3, 70, "Text",
Evaluatable->False],
Cell[23075, 677, 798, 12, 70, "Input"],
Cell[23876, 691, 278, 5, 70, "Text",
Evaluatable->False],
Cell[24157, 698, 429, 7, 70, "Text",
Evaluatable->False],
Cell[24589, 707, 209, 4, 70, "Text",
Evaluatable->False]
}, Closed]],
Cell[CellGroupData[{
Cell[24830, 713, 160, 5, 70, "Section",
Evaluatable->False,
PageBreakAbove->False],
Cell[24993, 720, 224, 5, 70, "Text",
Evaluatable->False,
PageBreakAbove->False],
Cell[25220, 727, 165, 4, 70, "Text",
Evaluatable->False]
}, Closed]]
}, Open ]]
}
]
*)
(***********************************************************************
End of Mathematica Notebook file.
***********************************************************************)