Diffusion-Limited Aggregation

Mathematica  code as it appeared in Mathematica in Education, 
Volume 1, No. 3, Spring 1992.

Richard J. Gaylord
Department of Materials Science
University of Illinois, Urbana
gaylord@ux1.cso.uiuc.edu

and

William Tyndall
Pompton Lakes High School
74130.2737@compuserve.com

Figure 1 (color).

Clear[dLA]
dLA[r_, n_Integer, m_Integer] :=
 Block[{angle, loc, particleCount = 0,  
		stepChoices = {{1, 0}, {0, 1}, {-1, 0}, {0, -1}}, 
		structure = {}}, occupiedSites = {{0,0}};
	While[Length[occupiedSites] < n,  
		angle = Random[Real, {0, N[2 Pi]}]; 
		loc = Floor[{r Cos[angle], r Sin[angle]}]; 
		++particleCount;
	While[Abs[loc[[1]]] < r + m && Abs[loc[[2]]] < r + m && 
		 	!MemberQ[occupiedSites, loc] && 
		 	Length[Intersection[occupiedSites, Map[(# + loc)&, stepChoices]]] == 0, 
		loc += stepChoices[[Random[Integer, {1, 4}]]] ];
	If[Length[Intersection[occupiedSites, 
		Map[# + loc &, stepChoices]]] =!= 0, 
		AppendTo[occupiedSites, loc] ]       ];               
		Print["The number of particles released was  ", 
	particleCount]; Print["The size of the dla is  ", Length[occupiedSites]]; 
		Do[AppendTo[
			structure,{RGBColor[0.1, 0.9 i/Length[occupiedSites],0.52],				Rectangle[occupiedSites[[i]] - {0.5, 0.5}, 
			occupiedSites[[i]] + {0.5, 0.5}], RGBColor[1, 1, 1],
			Text[i,occupiedSites[[i]]]}], {i, 1, Length[occupiedSites]}];
Show[Graphics[structure], 
	Axes->None, 
	AspectRatio -> 1, 
	PlotRange -> {{-(r +1), (r +1)}, {-(r + 1), (r + 1)}}] ]

SeedRandom[0]
dLA[5, 36, 5]

Figure 1 (gray).

Clear[graydLA]
graydLA[r_, n_Integer, m_Integer] :=
 Block[{angle, loc, particleCount = 0,  
		stepChoices = {{1, 0}, {0, 1}, {-1, 0}, {0, -1}}, 
		structure = {}}, occupiedSites = {{0,0}};
	While[Length[occupiedSites] < n,  
		angle = Random[Real, {0, N[2 Pi]}]; 
		loc = Floor[{r Cos[angle], r Sin[angle]}]; 
		++particleCount;
	While[Abs[loc[[1]]] < r + m && Abs[loc[[2]]] < r + m && 
		 	!MemberQ[occupiedSites, loc] && 
		 	Length[Intersection[occupiedSites, Map[(# + loc)&, stepChoices]]] == 0, 
		loc += stepChoices[[Random[Integer, {1, 4}]]] ];
	If[Length[Intersection[occupiedSites, 
		Map[# + loc &, stepChoices]]] =!= 0, 
		AppendTo[occupiedSites, loc] ]       ];               
		Print["The number of particles released was  ",particleCount];
		Print["The size of the dla is  ", Length[occupiedSites]]; 
		Do[AppendTo[structure,{GrayLevel[i/Length[occupiedSites]],
			Rectangle[occupiedSites[[i]] - {0.5, 0.5}, 
						occupiedSites[[i]] + {0.5, 0.5}], 
						GrayLevel[1],		   
						Text[i, occupiedSites[[i]]]}], 
		 {i, 1, Length[occupiedSites]}];
Show[Graphics[structure], 
	Axes->None, 
	AspectRatio ->1, 
	PlotRange->{{-(r +1), (r +1)}, {-(r + 1), (r + 1)}}] ]

SeedRandom[0]
graydLA[5,36,5]

Figure 2.

Dynamic[occupiedSites_List] :=
	Block[{dynamics = {}},
		xMax = Max[Transpose[occupiedSites][[1]]];
xMin = Min[Transpose[occupiedSites][[1]]]; xRange = {xMin -1, xMax +1};  
yMax = Max[Transpose[occupiedSites][[2]]]; yMin = Min[Transpose[occupiedSites][[2]]]; yRange =  {yMin -1, yMax +1}; 
Do[AppendTo[dynamics,
  Show[Graphics[ 
	RGBColor[0.9, 0.5, 0.9], 
	PointSize[0.115], 
	Point[occupiedSites[[i]]], 
	RGBColor[0.228, 0.599, 0.256] , 
	Text[i, occupiedSites[[i]]],
	Axes->None, 
	PlotRange->{xRange, yRange}, 
	AspectRatio->1, 
	DisplayFunction->Identity]]];
  Show[dynamics, DisplayFunction->Identity],              
{i, Length[occupiedSites]}
] ]

Dynamic[occupiedSites];

Figure 3.

Figure 3.a

Clear[fractalDimension]
fractalDimension[occupiedSites_List]:= Block[
	{sitesInArea, area, occupiedSitesInArea, 
	 numberOfOccupiedSitesInArea, numberDensity, 
	 fractalDataList,latticeDensity},
latticeDensity[t_Integer]:= N[Count[occupiedSites, 
{x_?(Abs[#] <= t &), y_?(Abs[#] <= t &)}]]/(2t+1)^2;
fractalDataList = Table[{2s, latticeDensity[s]},
	{s, Max[Abs[xMax], Abs[yMax], Abs[xMin], Abs[yMin]]}]; 
logLogFractalDataList = N[Map[Log, fractalDataList]];
fracdim = Fit[logLogFractalDataList, {1, x}, x];
Print["The fractal dimension of the DLA is   ",Coefficient[fracdim, x]];
LogLogListPlot[fractalDataList, 
	PlotStyle->{PointSize[.045],
	RGBColor[0.763, 0.244, 0.251]}]
]

fractalDimension[occupiedSites]

Figure 3.b

(* note: the fractalDimension program which uses the 
    anonymous function (Abs[#] <= t)&
 *)
 
fractalDimension2[occupiedSites_List] :=
Block[{fractalDataList},
latticeDensity[t_Integer] :=
N[Count[occupiedSites, {x_?(Abs[#] <= t &), y_?(Abs[#] <= t &)}]]/(2t
+1)^2;
fractalDataList = Table[{2s, latticeDensity[s]}, 
	{s, Max[Abs[xMax], Abs[yMax], Abs[xMin], Abs[yMin]]}] ]
is equivalent to the much longer fractalDimension program:
 fractalDimension3[occupiedSites_List] :=
Block[{sitesInArea, area, occupiedSitesInArea,		      
		numberOfOccupiedSitesInArea, numberDensity},
	fractalDataList = {};
	Do[
			sitesInArea = Flatten[Table[{i, j}, {i, -s, s}, {j, -s, s}], 1];
			area = Length[sitesInArea];
			occupiedSitesInArea = Intersection[sitesInArea, occupiedSites];
numberOfOccupiedSitesInArea = Length[occupiedSitesInArea]; numberDensity = N[numberOfOccupiedSitesInArea/area]; AppendTo[fractalDataList, {2s, numberDensity}],
{s, Max[Abs[xMax], Abs[yMax], Abs[xMin], Abs[yMin]]} ];
			fractalDataList
				]

fractalDimension[occupiedSites]