2D random walk within a bounded area
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 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]]