Bootstrap Percolation

Author

Eric W. Weisstein
November 24, 2003

This notebook downloaded from http://mathworld.wolfram.com/notebooks/CellularAutomata/BootstrapPercolation.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/BootstrapPercolation.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

p=0.04

init1=Table[If[Random[Real]<.05,1,0],{25},{25}]

Count[Flatten[init1],1]/25^2//N

ca1=FixedPointList[CellularAutomaton[{1018,{2,{{0,2,0},{2,1,2},{0,2,0}}},{1,1}},#,1,{{1,1},All}][[1]]&,
init1
];

p=0.05

init2=Table[If[Random[Real]<.05,1,0],{25},{25}]

Count[Flatten[init2],1]/25^2//N

ca2=FixedPointList[CellularAutomaton[{1018,{2,{{0,2,0},{2,1,2},{0,2,0}}},{1,1}},#,1,{{1,1},All}][[1]]&,
init2
];

p=0.08

init3=Table[If[Random[Real]<.09,1,0],{25},{25}]

Count[Flatten[init3],1]/25^2//N

ca3=FixedPointList[CellularAutomaton[{1018,{2,{{0,2,0},{2,1,2},{0,2,0}}},{1,1}},#,1,{{1,1},All}][[1]]&,
init3
];

Animation

Length/@{ca1,ca2,ca3}

m=Max[%]

cas=Join[#,Table[Last[#],{m-Length[#]}]]&/@{ca1,ca2,ca3};

Length/@cas

movie=Show[#,ImageSize->500]&/@(GraphicsArray[{
RasterGraphics[#[[1]],PlotLabel->TraditionalForm[p==.04]],
RasterGraphics[#[[2]],PlotLabel->TraditionalForm[p==.05]],
RasterGraphics[#[[3]],PlotLabel->TraditionalForm[p==.08]]
}]&/@Transpose[cas]);//Timing

<<GIF`;

Export[gifs<>"bootperc.gif",movie]//Timing