3D Walks

A.P. 1601
Columbia University

Introduction

In this notebook, we extend the results of 6-RandomWalks.nb and 7-SelfAvoiding Walks.nb from 2D to 3D.

Random Walks

walk3D[n_]:=NestList[#1+{{0,0,1},{0,1,0},{1,0,0},{0,0,-1},{0,-1,0},{-1,0,0}}[[RandomInteger[{1,6}]]]&,{0,0,0},n]

showWalk3D[pts_List,opts___] := Show[Graphics3D[Line[pts],opts,AspectRatio-> Automatic]]

(awalk = walk3D[50000];) // Timing

showWalk3D[awalk, Axes-> True];

Statistics in Three-Dimensions

nWalkers = 1000;
walkList = Table[walk3D[500],{nWalkers}];

walkList // Shallow (* 1000 walks 500 steps long *)

Average position ("center of mass")

avgXYZ[walkers_List] := N[(Plus @@ walkers)/Length[walkers]]

avgXYZList = avgXYZ /@ Transpose[walkList];

avgXYZList // Shallow

ListPlot[Transpose[avgXYZList][[1]],PlotLabel->"Average X-Position of All Walkers vs Time"]

The average position of all walkers remains near the orgin (as expected).

Average radius

radius[{x_, y_, z_}] := Sqrt[N[x^2 + y^2 + z^2]]

rList = Map[radius, walkList,{2}];

avgR=Mean/@Transpose[rList];
ListPlot[avgR]

Modeling average radius per step

The average radius increases at a power-law of the number of steps.

rData=Transpose[{Table[N[Log[n]],{n,2,Length[avgR]}],N[Log[Drop[avgR,1]]]}];
ListPlot[rData,PlotRange->All]

power = Fit[rData,{x}, x]

Therefore, ⟨r⟩ ~ (Sqrt[n]).

4D Walking

walk4D[n_]:=NestList[#1+{{0,0,0,1},{0,0,0,-1},{0,0,1,0},{0,0,-1,0},{0,1,0,0},{0,-1,0,0},{1,0,0,0},{-1,0,0,0}}[[RandomInteger[{1,8}]]]&,{0,0,0,0},n]

walk4D[4]

(awalk = walk4D[50000];) // Timing

Dimensions[awalk]

Dimensions[awalk[[All,{1,2,3}]]]

showWalk3D[awalk[[All,{1,2,3}]], Axes-> True];

showWalk3D[awalk[[All,{1,2,4}]], Axes-> True];

nWalkers = 1000;
walkList = Table[walk4D[500],{nWalkers}];

Average position ("center of mass")

avgXYZ[walkers_List] := N[(Plus @@ walkers)/Length[walkers]]

avgXYZList = avgXYZ /@ Transpose[walkList];

avgXYZList // Shallow

ListPlot[Transpose[avgXYZList][[1]],PlotLabel->"Average X-Position of All Walkers vs Time"]

ListPlot[Transpose[avgXYZList][[4]],PlotLabel->"Average ZZ-Position of All Walkers vs Time"]

The average position of all walkers remains near the orgin (as expected).

Average radius

radius[{x_, y_, z_, zz_}] := Sqrt[N[x^2 + y^2 + z^2 + zz^2]]

rList = Map[radius, walkList,{2}];

avgR=Mean/@Transpose[rList];
ListPlot[avgR]

Modeling average radius per step

The average radius increases at a power-law of the number of steps.

rData=Transpose[{Table[N[Log[n]],{n,2,Length[avgR]}],N[Log[Drop[avgR,1]]]}];
ListPlot[rData,PlotRange->All]

power = Fit[rData,{x}, x]

Therefore, ⟨r⟩ ~ (Sqrt[n]).

Self-Avoiding Walks

For three-dimensional self-avoiding walks, we need consider nine rotations: 
	• rotate x-y by 90 Degrees, 180 Degrees, or 270 Degrees
	• rotate x-z by 90 Degree, 180 Degrees, or 270 Degrees
	• rotate y-z by 90 Degree, 180 Degree, or 270 Degrees

Needs["Geometry`Rotations`"];

?RotationMatrix3D

x-y rotations

a = 90 Degree;{RotationMatrix3D[a, 0, 0],RotationMatrix3D[a, 0, 0] // MatrixForm}

a = 180 Degree;{RotationMatrix3D[a, 0, 0],RotationMatrix3D[a, 0, 0] // MatrixForm}

a = 270 Degree;{RotationMatrix3D[a, 0, 0],RotationMatrix3D[a, 0, 0] // MatrixForm}

y-z rotations

a = 90 Degree;{RotationMatrix3D[0, a, 0],RotationMatrix3D[0, a, 0] // MatrixForm}

a = 180 Degree;{RotationMatrix3D[0, a, 0],RotationMatrix3D[0, a, 0] // MatrixForm}

a = 270 Degree;{RotationMatrix3D[0, a, 0],RotationMatrix3D[0, a, 0] // MatrixForm}

x-z rotations

a = 90 Degree;
b = 90 Degree;{RotationMatrix3D[b, a, -b],RotationMatrix3D[b, a, -b] // MatrixForm}

a = 180 Degree;
b = 90 Degree;{RotationMatrix3D[b, a, -b],RotationMatrix3D[b, a, -b] // MatrixForm}

a = 270 Degree;
b = 90 Degree;{RotationMatrix3D[b, a, -b],RotationMatrix3D[b, a, -b] // MatrixForm}

Twist

twist[chain_List]:=Module[{n,iPivot,fixpart,movepart,rotchoice,newpart,newchain,rot},rot={{{0,1,0},{-1,0,0},{0,0,1}},{{-1,0,0},{0,-1,0},{0,0,1}},{{0,-1,0},{1,0,0},{0,0,1}},{{1,0,0},{0,0,1},{0,-1,0}},{{1,0,0},{0,-1,0},{0,0,-1}},{{1,0,0},{0,0,-1},{0,1,0}},{{0,0,-1},{0,1,0},{1,0,0}},{{-1,0,0},{0,1,0},{0,0,-1}},{{0,0,1},{0,1,0},{-1,0,0}}};n=Length[chain]-1;iPivot=RandomInteger[{1,n-1}];fixpart=Take[chain,iPivot];movepart=Take[chain,iPivot-(n+1)];rotchoice=rot[[RandomInteger[{1,9}]]];newpart=(chain[[iPivot]]+(#1-chain[[iPivot]]).rotchoice&)/@movepart;If[newpart⋂fixpart=={},newchain=Join[fixpart,newpart],chain]]

Example 3D SAWs

nSteps=1000;
chain0=Table[{i,0,0},{i,0,nSteps}];
chain100=Nest[twist,chain0,100];
chain500=Nest[twist,chain100,400];
chain1000=Nest[twist,chain500,500];
Show[GraphicsRow[{showWalk3D[chain100,DisplayFunction->Identity],showWalk3D[chain500,DisplayFunction->Identity],showWalk3D[chain1000,DisplayFunction->Identity]}],DisplayFunction->$DisplayFunction]

First /@ {chain0, chain100, chain500, chain1000}

Last /@ {chain0, chain100, chain500, chain1000}

Radius at end of walk…

N[Sqrt[#1^2 + #2^2 + #3^2]]& @@@ %

Summary

As it turns out, Mathematica can display and process three-dimensional data just as simply as it deals with two-dimensions. Generating 3D random and self-avoiding walks is minor extension from three-dimensions.