# 2D random walk within a bounded area

I want to simulate a random walk on two dimension in a bounded area such as a square or circle. I am thinking of using If statement to define a boundary. Is there a better way to define a bounded region?

-
Probably you do not need If. Is your stepSize always a unit in a random direction? – hieron Aug 17 '14 at 22:05
Yes the step size is unit in a random direction. At each point I use a random number to decide where to go. I want when I reach the boundary either go to other direction inside the boundary or simply abort the random walk. – MOON Aug 17 '14 at 22:15
– kglr Aug 17 '14 at 23:29
@kguler My emphasis here is creating the bounded region. – MOON Aug 18 '14 at 0:16
I think now I can look at the codes provided and figure out how I can create the bounded region in a random walk. Later I will generalize this to create an arbitrary shaped bounded region. Such as a circle with a hole in it. – MOON Aug 18 '14 at 0:22

To answer your question: I don't think it's a bad or good idea to use If. It depends on how you do it. To demonstrate I'll use If combined very powerfully with Mathematica 10's ability to tell if a point is inside a specified region or not.

step[position_, region_] := Module[{randomStep},
randomStep = RandomChoice[{{-1, 0}, {1, 0}, {0, -1}, {0, 1}}];
If[
Element[position + randomStep, region],
position + randomStep,
position
]
]

randomWalk[region_, n_] := NestList[
step[#, region] &,
{0, 0},
n
]

visualizeWalk[region_, n_] := Graphics[{
White, region,
Black, Line[randomWalk[region, n]]
}, Background -> Black]

visualizeWalk[Disk[{0, 0}, 30], 10000]


This version of visualizeWalk accepts arbitrary regions:

visualizeWalk[graphics_, region_, n_] := Graphics[{
White, graphics,
Black, Line[randomWalk[region, n]]
}, Background -> Black]

region = {
Disk[{-25, 0}, 30, {-Pi/2, Pi/2}],
Disk[{25, 0}, 30]
};
visualizeWalk[region, RegionUnion[region], 10000]


visualizeWalk[
{Disk[{-17.5, 0}, 30], Darker@Gray, Disk[{-17.5, 0}, 15]},
RegionDifference[Disk[{-17.5, 0}, 30], Disk[{-17.5, 0}, 15]]
, 10000]


-
I hope your elegant solution will receive the attention it deserves. – eldo Aug 18 '14 at 0:46
Apparently Element is the fancy geometry function I was envisioning. Not intimidating to use at all (unlike most other geometry functions I've come across). +1. – seismatica Aug 18 '14 at 0:50
I think the position should remain the same (instead of position - randomStep) when the next step is out of the circle, since there will be cases where plus step and minus step will both be out of the circle. Evaluate visualizeWalk[region_, n_] := Graphics[{Opacity[0.5, Red], region, Black, Line[randomWalk[region, n]]}]; visualizeWalk[Disk[{0, 0}, 3], 1000] for example. – seismatica Aug 18 '14 at 1:26
Your strategy of reversing the move when crossing the edge makes the step near the edge not uniformly distributed. Instead of 1:1:1:1 the move odds become 1:2:1 instead of the 1:1:1 they should be. – Sparr Aug 18 '14 at 4:43
@Pickett 1:1:1 is my suggestion. that is, an even choice between the legal moves, not double chance of the move away from the wall. – Sparr Aug 18 '14 at 13:34

I suggest using Mod - a natural thing for looped boundary conditions on a torus.

Finite torus surface area is your bounded region.

2D random walk generally is simple:

walk = Accumulate[RandomReal[{-.1, .1}, {100, 2}]];
Graphics[Line[walk], Frame -> True]


Confinement to square region {{0,1},{0,1}} would be simple in principle with Mod[walk,1] (periodic boundary conditions) but visualizing will be hard:

Graphics[Line[Mod[walk, 1]], Frame -> True]


So I think logical, for periodic boundary conditions, to place it on a torus ( with arbitrary radiuses ):

map[φ_, θ_] = CoordinateTransformData["Toroidal" -> "Cartesian",
"Mapping", {r, θ, φ}] /. {\[FormalA] -> 1, r -> 2 Log[2]}


walk = Accumulate[RandomReal[{-.1, .1}, {10^4, 2}]];
Graphics3D[{Opacity[.5], Line[map @@@ walk]}, SphericalRegion -> True]


-

Here's my implement of a random walk within a circle using If and FoldList. Please see @Pickett's answer for more thorough implementation for arbitrary regions. Code updated to flesh out behavior near edge of region (if a step becomes out of bound, the current position will randomly look for the other step types that would stay in the region). I also added some formatting to the display to indicate the positions and indices of the point and when it's about to hit the edge of the region (highlighted in red).

Clear[randomWalk]
randomWalk[steps_Integer, start_, region_] /;
start ∈ region :=
DynamicModule[{stepTypes, stepList, alternativeStep, stepChoice,
positions, edgePositions, pointPrimitives, text},

(* 4 types of steps: {{0,1},{1,0},{0,-1},{-1,0}}: up, down, left,
right *)
stepTypes = Flatten[Permutations[#, {2}] & /@ {{0, 1}, {0, -1}}, 1];

(* Generate list of random steps *)
stepList = RandomChoice[stepTypes, steps];

(* If a step were to result in position outside of circle,
the step is not taken,
an alternative step type is chosen randomly from the remaining \
types; also,
the position near the edge woule also be Sowed to be Reaped later.
Otherwise, the step is taken *)
alternativeStep[currentPosition_, nextStep_] :=
RandomChoice[
Select[Complement[
stepTypes, {nextStep}], (currentPosition + # ∈
region &)]];
stepChoice[currentPosition_, nextStep_, nearEdgePosition_] :=
If[currentPosition + nextStep ∈ region,
currentPosition + nextStep,
(Sow[nearEdgePosition];
(* else *)
currentPosition + alternativeStep[currentPosition, nextStep])];

(* List of all positions and near edge positions *)
{positions, edgePositions} =
FoldList[stepChoice[#1, Sequence @@ #2] &, start,
MapIndexed[List, stepList]] // Reap;

(* Display *)
pointPrimitives[
n_Integer] := {If[MemberQ[Flatten@edgePositions, n], Red, Black],
Point[positions[[n]]]};
text[n_Integer] :=
Text[Style[Row@{n, ": ", positions[[n]]},
If[MemberQ[Flatten@edgePositions, n], Red, Black], Bold,
15], {Right, Top}, {1., 1.}];
Manipulate[
Graphics[{Gray, region, AbsolutePointSize[5], White,
Point[positions], pointPrimitives[i], text[i]}, Frame -> True,
ImagePadding -> 25], {i, 1, Length[positions], 1}]
]

randomWalk[1000, {4, 4}, Disk[{0, 0}, 7]]


You can export this as an animation by creating a list of frames e.g. by using Table instead of Manipulate. Don't forget to change DynamicModule to Module or you'll get an image of a table of frames instead of an animation using Export["randomwalk.gif", frames]. This is because even though it will look like a list of frames in the notebook, DynamicModule will still wrap that list. All credits to @Pickett for this tip. Warning: gif might be slow to load.

Code can be easily adapted to 3D

Clear[randomWalk3D]
randomWalk3D[steps_Integer, start_, region_] /;
start ∈ region :=
DynamicModule[{stepTypes, stepList, alternativeStep, stepChoice,
positions, edgePositions, pointPrimitives, text},

(* 6 types of steps for 3D *)
stepTypes =
Flatten[Permutations[#, {3}] & /@ {{0, 0, 1}, {0, 0, -1}}, 1];

(* Generate list of random steps *)
stepList = RandomChoice[stepTypes, steps];

(* If a step were to result in position outside of circle,
the step is not taken,
an alternative step type is chosen randomly from the remaining \
types; also,
the position near the edge woule also be Sowed to be Reaped later.
Otherwise, the step is taken *)
alternativeStep[currentPosition_, nextStep_] :=
RandomChoice[
Select[Complement[
stepTypes, {nextStep}], (currentPosition + # ∈
region &)]];
stepChoice[currentPosition_, nextStep_, nearEdgePosition_] :=
If[currentPosition + nextStep ∈ region,
currentPosition + nextStep,
(Sow[nearEdgePosition];
(* else *)
currentPosition + alternativeStep[currentPosition, nextStep])];

(* List of all positions and near edge positions *)
{positions, edgePositions} =
FoldList[stepChoice[#1, Sequence @@ #2] &, start,
MapIndexed[List, stepList]] // Reap;

(* Display *)
pointPrimitives[
n_Integer] := {If[MemberQ[Flatten@edgePositions, n], Red, Black],
Point[positions[[n]]]};
text[n_Integer] :=
Epilog ->
Inset[Style[Row@{n, ": ", positions[[n]]},
If[MemberQ[Flatten@edgePositions, n], Red, Black], Bold,
15], {Right, Top}, {Right, Top}];

Manipulate[
Graphics3D[{Opacity[0.5, Gray], region, AbsolutePointSize[5],
White, Point[positions], pointPrimitives[i]}, text[i],
ImagePadding -> 25, Lighting -> {{"Ambient", Gray}}], {i, 1,
Length[positions], 1}]
]

randomWalk3D[1000, {4, 4, 4}, Ball[{0, 0, 0}, 7]]


-
Sorry Pickett I updated my post just as you updated it! Will fix it now. – seismatica Aug 18 '14 at 0:05
@Pickett, Thanks, I deleted my answer – eldo Aug 18 '14 at 0:18
Those are nice visualizations! (You already have my +1) – C. E. Aug 18 '14 at 14:48
Thank you! Glad you like them. – seismatica Aug 18 '14 at 21:06

I chose the WienerProcess as the underlying random process, as this will simulate a Brownian motion.

# Until Boundary Hit

Module[{rd = Transpose @ RandomFunction[WienerProcess[], {0, 1000, .01}, 2]["States"], length},
length = LengthWhile[rd, # ∈ Rectangle[{-2, -2}, {+2, +2}] &];
ListPlot[rd[[;; length]], Joined -> True, Mesh -> All, PlotRange -> {{-2.5, 2.5}, {-2.5, 2.5}},
Epilog -> {EdgeForm[Thick], White, Opacity[0], Rectangle[{-2, -2}, {+2, +2}]}, ImageSize -> Large]
]


# Other Direction Inside the Boundary

First the single moves as definded by a WienerProcess:

randomMove = Transpose[Differences /@
RandomFunction[WienerProcess[], {0, 100, .1}, 2]["States"]];


These are

Length@randomMove

1000


steps.

We'll start at

start = {0., 0.};


and define the boundary as a square

box2D = Rectangle[{-2, -2}, {+2, +2}];


Now the random walk inside this box is created with:

last = start;
walk = First@Last@Reap@Do[
new = last + randomMove[[i]];
If[new ∈ box2D,
last = new;
Sow@new, Null],
{i, Length@randomMove}
];
randomInTheBox = Prepend[walk, start];


In my last run these where

Length@randomInTheBox

882


points.

A plot of the result:

ListPlot[randomInTheBox, Joined -> True, Mesh -> All, MeshStyle -> Black, AspectRatio -> 1,
Epilog -> {EdgeForm[{Thick, Red}], White, Opacity[0],
Rectangle[{-2, -2}, {+2, +2}]}, ImageSize -> Large]


The walk can be traced with

Manipulate[ListPlot[randomInTheBox, Joined -> True, Mesh -> All,
MeshStyle -> Black, AspectRatio -> 1,
Epilog -> {PointSize[Medium], Red, Point[randomInTheBox[[p]]],
EdgeForm[{Thick, Red}], Opacity[0], box2D}],
{p, 1, Length@randomInTheBox, 1}]


If you need to run this simulation multiple times, it is beneficial to put these steps together, e.g.

randomInTheBox = Prepend[
Block[{randomMove = Transpose[Differences /@
RandomFunction[WienerProcess[], {0, 100, .1}, 2]["States"]],
length, last, new},
length = Length@randomMove;
last = start;
First@Last@Reap@Do[
new = last + randomMove[[i]];
If[new \[Element] box2D,
last = new;
Sow@new, Null],
{i, Length@randomMove}]
],
start];


The random process can easily be replaced by an other one and a different definition for the bounding area be chosen. Furthermore an extension of this approach to 3D is straight forward.

-
I'm not advanced enough to fully understand your method but it's very cool! Can definitely see the Brownian in there. – seismatica Aug 18 '14 at 6:35

Walking infinitely in a random and acceptable direction within a rectangle on button click, stepSize = 1.

DynamicModule[{newDir, walk = {{0, 0}}, oldPos, newPos = {0, 0},
acceptQ = -20 <= #[[1]] <= +20 && -10 <= #[[2]] <= +10 &},
{
Button["Next Step", oldPos = newPos;
newPos = {\[Infinity], \[Infinity]};
While[Not@acceptQ@newPos, newDir = RandomReal@{-Pi, +Pi};
newPos = oldPos + {Cos@newDir, Sin@newDir}];
walk = Append[walk, newPos]],
Dynamic@
Graphics[{White, Rectangle[{-20, -10}, {20, 10}], Gray, Line@walk,
Point@walk, Red, Point@newPos}, ImageSize -> 500, Frame -> True]
} // Column]


-