Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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?

share|improve this question
    
Probably you do not need If. Is your stepSize always a unit in a random direction? –  hieron Aug 17 at 22:05
1  
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. –  yashar Aug 17 at 22:15
1  
related Q/A? –  kguler Aug 17 at 23:29
    
@kguler My emphasis here is creating the bounded region. –  yashar Aug 18 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. –  yashar Aug 18 at 0:22

5 Answers 5

up vote 25 down vote accepted

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]

Random walk in a disk

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]

Random walk in a union of regions

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]

Using region difference to create a region

share|improve this answer
1  
I hope your elegant solution will receive the attention it deserves. –  eldo Aug 18 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 at 0:50
1  
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 at 1:26
1  
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 at 4:43
1  
@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 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]

enter image description here

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]

enter image description here

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]}

enter image description here

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

enter image description here

share|improve this answer

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.

random walk


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]]

randomWalk3d

share|improve this answer
1  
Sorry Pickett I updated my post just as you updated it! Will fix it now. –  seismatica Aug 18 at 0:05
1  
@Pickett, Thanks, I deleted my answer –  eldo Aug 18 at 0:18
2  
Those are nice visualizations! (You already have my +1) –  Pickett Aug 18 at 14:48
    
Thank you! Glad you like them. –  seismatica Aug 18 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]
 ]

untilbountaryhit

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]

randomInTheBox

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.

share|improve this answer
    
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 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]

randomWalk

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.