I need to generate a plot that shows the averaged position at n steps of 1000 different random walks that are each 1000 steps long. So far I am using Accumulate[RandomChoice[{{1, 0}, {-1, 0}, {0, 1}, {0, -1}}, 1000]] to generate the random walk of 1000 steps. By changing it to a function: randomWalk[n_] :=Accumulate[RandomChoice[{{1, 0}, {-1, 0}, {0, 1}, {0, -1}}, n]] I have found that I can use Table[randomWalk[1000], (anynumber)] to generate "any-number" of walks that are 1000 steps long. What I need now is to create a plot that shows the average position of the 1000 walks at each step, i.e. average position of 1000 walks for step 1, average position of 1000 walks for step 2......step 1000. I'm not sure how to go about this.
$\begingroup$
$\endgroup$
2
3 Answers
$\begingroup$
$\endgroup$
Here is an example:
n = 1000;
rw = RandomInteger[{-1, 1}, {n, n}];
rw = Accumulate /@ rw;
ListLinePlot[Mean /@ Transpose[rw]]
$\begingroup$
$\endgroup$
It is especially convenient to make use of built-in functions like TemporalData to facilitate the analysis.
Starting with your two-dimensional step function:
randomWalk[n_] :=
Accumulate[RandomChoice[{{1, 0}, {-1, 0}, {0, 1}, {0, -1}}, n]]
walks = With[{anynumber = 1000},
TemporalData[#, {1}] &@ Table[randomWalk[1000], (anynumber)]]
This generates a TemporalData entity, which we can use to extract the properties at any later time (i.e., at any "slice" of the collection of walkers:
Manipulate[
ListPlot[walks["SliceData", t],
PlotRange -> {{-31, 31}, {-31, 31}}, AspectRatio -> 1],
{t, 1, 1000}]
We can extract values at any particular time slice and operate on them, e.g., to see the average value of the x and y values as a function of time
averages = Table[ Mean@walks["SliceData", t], {t, walks["PathLength"]}];
ListPlot@Transpose@averages
As suggested in the past, perhaps you want to know the average distance from the origin as a function of time (using Norm instead of EuclideanDistance for no particular reason)
ListPlot@Table[
Mean@Map[Norm]@walks["SliceData", t],
{t, walks["PathLength"]}]
$\begingroup$
$\endgroup$
I believe that you may have intended average Euclidean distance from the per step and not average two-dimensional position per step.
Nonetheless, I provide both. In the position plot, running in Mathematica, when hovering over a point with your cursor, the step number will be displayed.
nSteps = 1000
nWalks = 1000
steps = {{1, 0}, {0, 1}, {-1, 0}, {0, -1}}
start = {0, 0}
places = Mean /@ FoldList[Plus, Evaluate[
Transpose[Table[RandomChoice[steps, nSteps], nWalks]]]];
Graphics[(Tooltip @@ #1 & ) /@ Transpose[
{Point /@ places, (StringJoin[" ", ToString[#1]] & ) /@
Range[Length[places]]}], Frame -> True, Axes -> True,
AxesOrigin -> {0, 0}, GridLines -> Automatic,
PlotLabel -> "Average position"]
ListPlot[(EuclideanDistance[start, #1] & ) /@ places,
Frame -> True, Axes -> True, GridLines -> Automatic,
PlotLabel -> "Average distance from origin"]
Of course, your plot will be different. This is a Monte Carlo simulation, anyway.
Of course, I may have missed something.
Mean /@ Transpose[Table[randomWalk[1000], 1000]]- that is, create a list of thousand random walks, andTransposethe result so that results for each step are on their own list, and thenMapMeanon each of these vectors, giving a list of per-step means. I would also suggest taking a look atguide/RandomProcessesin documentation, which allows analytical reasoning of these sort of processes (although two-dimensional random walk has to be constructed usingTransformedProcess). $\endgroup$// ListLinePlot[#, AspectRatio -> Automatic] &on the end to plot the result. $\endgroup$