3
$\begingroup$

I'm hoping to animate the trajectory of a 2D Brownian Motion. Here's my attempt, which is based on what I've read in Mathematica's documentation:

SeedRandom[666];
Animate[ListLinePlot[
  Transpose[RandomFunction[WienerProcess[], {0, T, .001}, 2]["ValueList"]]], 
  {T, 0, 0.04}, 
  AnimationRunning -> False]

There are two things that I'm seeking help with:

  1. It doesn't look like the seed is fixed. When I animate the parameter T (the ending time of the Brownian Motion), it appears as though I get a different trajectory after each time step.

  2. I'd like the window to be of fixed size. For example, having each of the horizontal and vertical axes to range from -1 to 1.

Please let me know if you can help with either of these two items.

$\endgroup$
2
$\begingroup$

To fix the randomness problem, generate the random walk just once. To fix (pun intended*) the size of the plot area, use the PlotRange option.

SeedRandom[666]
endTime = .05;
data =
  Transpose[
    RandomFunction[WienerProcess[], {0, endTime, .001}, 2]["ValueList"]]

With[{s = .25},
  Animate[
    Graphics[Line[data[[;; i]]],
      Frame -> True,
      PlotRange -> s {{-1, 1}, {-1, 1}}],
    {i, 1, Length[data], 1},
    AnimationRunning -> False]]

plot

* For those readers who are not native-level English speakers, "fix" can mean both "repair" and "hold in place".

Update

After thinking more about this problem, I decided that I didn't like specifying an a-priori size for the plotting area. It is better to compute a plot rectangle that exactly contains the whole random walk. Here is how to do that.

SeedRandom[1]
endTime = .2;
data =
  Transpose[
   RandomFunction[WienerProcess[], {0, endTime, .001}, 2]["ValueList"]];

Module[{xrange, yrange},
  xrange = MinMax[data[[All, 1]]];
  yrange = MinMax[data[[All, 2]]];
  Animate[
    Graphics[Line[data[[;; i]]],
      Frame -> True,
      PlotRange -> {xrange, yrange}],
    {i, 1, Length[data], 1},
    AnimationRunning -> False,
    DefaultDuration -> 15]]

plot

$\endgroup$
  • $\begingroup$ Thanks very much! This is precisely what I was looking for. $\endgroup$ – Peter Jun 19 '17 at 17:55
0
$\begingroup$

To fix the region:

SeedRandom[666];
Animate[
 ListLinePlot[
  Transpose[
   RandomFunction[WienerProcess[], {0, t, .001}, 2]["ValueList"]], 
  PlotRange -> {{-.5, .5}, {-.5, .5}}], 
 {t, 0, 0.04},
 AnimationRunning -> False]

Note the use of lower-case t rather than T, to avoid potential conflicts with Mathematica's internal naming conventions.

More fundamentally, you seem to have a conceptual error: Your code produces a separate random walk for each time. There is no link between one time and the next... in short your animation does not show the progression of Brownian motion of a particle.

$\endgroup$
  • $\begingroup$ Thank you for your comment. I understand that my code gives a different random walk for each time and I'm trying to figure out which part of my code needs to be changed to fix this issue. I thought that setting the seed at the beginning would yield the same "random" function, but to different ending times specified by the parameter t. Do you have any suggestions? $\endgroup$ – Peter Jun 19 '17 at 17:52

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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