How to simulate a random walk to randomly generated particle to another particle fixed at the center of a grid?
So, here is my reformulations of C.E.'s code.
What has changed:
I use reservoirs
rand
andrandpts
of large random arrays; generating such arrays is much less expensive than generating every random number on its own.I use
RegionMember
andNearest
for the collision tests.
Implementation
getCluster[startcluster_, nparticles_, L_] := Module[{
getStartpoint, getDirection,
directions, cluster, nf, box, inboxQ, nrand, rand, nrandpts,
randpts, iparticle, irand, irandpts, particle, inbox
},
getStartpoint[] := Block[{p},
If[irandpts < nrandpts,
irandpts++,
irandpts = 1;
randpts = RandomInteger[{-L, L}, {nrandpts, 2}];
];
p = randpts[[irandpts]];
While[
Length[nf[p, {1, 0}]] > 0,
If[irandpts < nrandpts,
irandpts++,
irandpts = 1;
randpts = RandomInteger[{-L, L}, {nrandpts, 2}];
];
p = randpts[[irandpts]];
];
p
];
getDirection[] := (
If[irand < nrand,
irand++,
irand = 1;
rand = RandomInteger[{1, 4}, nrand];
];
directions[[rand[[irand]]]]
);
directions = Developer`ToPackedArray[{{0, 1}, {1, 0}, {0, -1}, {-1, 0}}];
(* set up a sufficiently large array to store the cluster in order to avoid the costly Append.*)
cluster = Join[startcluster, ConstantArray[{0, 0}, {nparticles}]];
nf = Nearest[cluster -> Automatic];
(* define the box and a collision checker *)
box = Rectangle[{-L, -L}, {L, L}];
inboxQ = RegionMember[box];
(* counters for the reservoirs for random numbers and points *)
irand = nrand = 1000000;
irandpts = nrandpts = 10000;
iparticle = Length[startcluster];
(* share some progress info with the user *)
PrintTemporary[
Dynamic[
Grid@
Transpose[{{"iparticle", "irand", "irandpts"}, {iparticle,
irand, irandpts}}]
]
];
While[iparticle < Length[cluster],
Check[particle = getStartpoint[];, Print["!"]];
inbox = True;
While[inbox,
Check[particle += getDirection[];, Print["?"]];
inbox = inboxQ[particle];
If[inbox,
If[Length[nf[particle, {1, 1}]] > 0,
Check[cluster[[iparticle]] = particle;, Print["."]];
nf = Nearest[cluster -> Automatic];
iparticle++;
inbox = False
]
]
]
];
Association[
"Cluster" -> cluster,
"Box" -> box,
"N" -> nparticles
]
];
And here a function to plot the particles with color according to their age:
showCluster[a_Association] := With[{L = a[["Box", 2, 2]]},
ArrayPlot[
Transpose@SparseArray[
(a[["Cluster"]] + (L + 1)) ->
Rescale[Range[Length[a[["Cluster"]]]]],
{2 L + 1, 2 L + 1},
2.
],
ColorFunction -> "DeepSeaColors",
PlotRange -> {0, 1},
ClippingStyle -> White,
DataReversed -> {True, False}
]
];
Usage example
A test run with 2000 particles, a single condensation core at {0,0}
, and a box of edgelength 101 = 2 * 50 + 1 (yes, this takes a bit):
data = getCluster[{{0, 0}}, 10000, 100]; // AbsoluteTiming // First
184.823
And here a plot of the result:
showCluster[data]
You can continue the simulation with
data2 = getCluster[data[["Cluster"]], 10000, 100]; // AbsoluteTiming // First
showCluster[data2]
28.3286
Surprisingly complex patterns!
This is like what you described, except that I also made sure that the particle didn't wander outside of the region $-100 \leq x, y \leq 100$ to ensure that convergence wouldn't take too long.
particles = {{0, 0}};
nf = Nearest[particles -> Automatic];
nextStep := RandomChoice[{{0, 1}, {1, 0}, {0, -1}, {-1, 0}}];
nParticles = 100;
l = 100;
inBounds[{x_, y_}, l_] := -l < x < l && -l < y < l
Do[
particle = RandomInteger[{-l, l}, 2];
While[
Length[nf[particle, {1, 1}]] == 0,
particle = RandomInteger[{-l + 1, l - 1}, 2];
];
step = nextStep;
While[
Length[nf[particle, {1, 1}]] == 0,
particle += step;
step = nextStep;
While[
! inBounds[particle + step, l],
step = nextStep;
]
];
AppendTo[particles, particle];
nf = Nearest[particles -> Automatic],
{nParticles}
];
Graphics[{
Point[particles]
}]