# Existing template for coalescing random walk

I would like to simulate a 2-dimensional random walk on a lattice where the particles coalesce/merge when they occupy a similar site on the lattice. Would it be possible to tweak in an efficient way the function RandomWalkProcess[p,q] such that when two particles collide they merge into one?

Edit: Here is my attempt:

ClearAll["Global*"];
tMax = 100;
gSize = 5;(*Grid Size*)
x = Table[0, {t, 1, tMax}];
n = 10; (*number of particles*)

pos0[n_] :=
pos0[n] = RandomInteger[{-gSize, gSize}, {n, 2}];(*Initial positions*)

x[[1]] = DeleteDuplicates[pos0[n]];
For[t = 2, t < tMax + 1, t++,
x[[t]] =
DeleteDuplicates[x[[t - 1]]]; (*if particle collides, merge it*)

n = Length@x[[t]];(* update number of particles*)

pt = RandomInteger[{1, n}];(*Choose random point*)

x[[t]][[pt]] += (-1)^Table[Random[Integer], {2}];(*move it*)
]


And here is a plot:

Animate[ListPlot[x[[time]],
PlotRange -> {{-3*gSize, 3*gSize}, {-3*gSize, 3*gSize}}], {time, 1,
tMax, 1}]


Are there any simple way to represent the result in a similar way to this picture?

• What have you tried so far? Can you, please, share with us the code that you are having trouble with, so that we may better help you? Jun 8, 2021 at 1:56
• Hey Matt, try this perhaps? iterator[list_] := (list /. l_List /; Length[l] == 3 :> l + RandomInteger[{-1, 1}, 3]) /. {a___, s1_List, b___, s2_List, c___} /; s1 === s2 :> {a, s1, b, {}, c} as your function, path = NestList[iterator, starts, 10000]; to generate paths, paths = Transpose[path] /. {} -> Nothing; to transpose as desired and terminate "joined" paths, and Graphics3D[{RandomColor[], Line@#} & /@ paths] to display? Jun 9, 2021 at 1:07
• i forgot to add that starts is, understandably, a list of starting points: starts = RandomInteger[{1, 10}, {20, 3}] (for example) Jun 9, 2021 at 1:15

Here is a nice template following Ben Kalziqi's comments:

### Template

n = 10; (*Number Particles*)
tMax := 1000
dim = 2;
iterator[list_] := (list /.
l_List /; Length[l] == dim :>
l + RandomInteger[{-1, 1}, dim]) /. {a___, s1_List, b___,
s2_List, c___} /; s1 === s2 :> {a, s1, b, {}, c}
starts = RandomInteger[{1, 100}, {n, dim}];
path = NestList[iterator, starts, tMax];
paths = Transpose[path] /. {} -> Nothing;


### Plotting:

3D

Graphics[{RandomColor[], Line@#} & /@ paths]


2D

ListPointPlot3D[paths, AxesLabel -> {"x", "y", "t"},
BaseStyle -> {FontSize -> 20,
FontFamily -> "Times"}(*,ScalingFunctions\[Rule]{None,None,"Log"}*),
ImageSize -> 700]


1D

For[j = 1, j < n + 1, j++,
For[i = 1, i < Length[paths[[j]]] + 1, i++,
AppendTo[paths[[j]][[i]], i]]]
ListLinePlot[paths]
`

A nice bonus would be that if two particles collided then the colour of their trajectory becomes the same...