3
$\begingroup$

Suppose that we have a dice with 4 faces. If the dice lands on:

  1. the person will move to the right
  2. the person will move to the left
  3. the person will move upward
  4. the person will move downward

The simulation has n steps and the position of the person updates on every step. How can I generate this random simulation?

test[n_] := Accumulate[RandomChoice[{{-1, 0}, {1, 0}, {0, 1}, {0, -1}}, n]]

How can I show the first/last point on the simulation if I use a function similar to ListLinePlot[test[10]]?

$\endgroup$
5
  • $\begingroup$ Look at RandomChoice $\endgroup$
    – Andy Ross
    Oct 5, 2015 at 2:10
  • $\begingroup$ See mathematica.stackexchange.com/q/57561/18476 $\endgroup$
    – Karsten7
    Oct 5, 2015 at 2:20
  • $\begingroup$ Also mathematica.stackexchange.com/a/78351 $\endgroup$
    – Karsten7
    Oct 5, 2015 at 2:25
  • $\begingroup$ test[n_] := Accumulate[RandomChoice[{{-1, 0}, {1, 0}, {0, 1}, {0, -1}}, n]], How can i plot this, $\endgroup$
    – seito
    Oct 5, 2015 at 2:37
  • $\begingroup$ ListLinePlot[#, PlotRange -> All, Mesh -> All, Epilog -> {Red, Point@Last@#}, AspectRatio -> Automatic] &@test[10] $\endgroup$
    – Karsten7
    Oct 5, 2015 at 3:14

2 Answers 2

3
$\begingroup$

You might implement your random walk something like this.

walk[n_] := 
  Prepend[
    Accumulate[RandomChoice[{{-1, 0}, {1, 0}, {0, 1}, {0, -1}}, n]], 
    {0, 0}]

trial[n_] := 
  Module[{path, start, end},
    path = walk[n];
    start = First @ path;
    end = Last @ path;
    ListLinePlot[path,
      Epilog -> {PointSize[Large], Point[start], Red, Point[end]},
      AspectRatio -> Automatic]]

SeedRandom[3]; trial[25]

walk

$\endgroup$
1
$\begingroup$
Clear["Global`*"]

SeedRandom[123];
walk[n_Integer, init_ : {0, 0}] := Module[{
   up = {0, 1},
   dn = {0, -1},
   right = {1, 0},
   left = {-1, 0}
   },
  steps = RandomChoice[{left, right, up, dn}, n];
  FoldList[Plus, init, steps]
  ]

walk[10, {1, 1}]  (*starting at {1,1} with 10 steps *)

{{1, 1}, {2, 1}, {2, 0}, {3, 0}, {2, 0}, {2, 1}, {2, 2}, {2, 3}, {2,
4}, {1, 4}, {0, 4}}


Visualization:

With[{n = 30},
 path = walk[n, {2, 2}] // Echo;
 ListLinePlot[Partition[path, 2, 1], AspectRatio -> Automatic
   , PlotStyle -> (ColorData["Rainbow"][#] & /@ Subdivide[n - 1])
   , PlotLegends -> Placed[BarLegend[{"Rainbow", {0, n}}], After]
   , PlotRangePadding -> Scaled[.15]
   , AspectRatio -> Automatic
   , Epilog -> {AbsolutePointSize@Large, Black
     , Point@path[[1]], Circle[path[[1]], 0.2]
     , Red, Point@path[[-1]], Circle[path[[-1]], 0.2]
     }
   ] /. Line[a__] :> Arrow[a, 0.05]
 ]

enter image description here

$\endgroup$
4
  • $\begingroup$ +1, but I get lots of error messages, which only go away after deleting /. Line[a__] :> Arrow[a, 0.05] $\endgroup$
    – eldo
    Feb 18 at 11:11
  • $\begingroup$ I am on v12.2 and copied code on this page to a fresh notebook. I get no error messages. Can you please include message information. Thanks for including information about the Arrow. $\endgroup$
    – Syed
    Feb 18 at 11:14
  • $\begingroup$ I'm on Version 13.3.0 and must delete the last line (the line to arrow transformation). Fresh kernel doesn't help. $\endgroup$
    – eldo
    Feb 18 at 11:24
  • $\begingroup$ You can start it as a new question by adding a minimal example. Perhaps it is a recently introduced bug. In the meantime, I will request the readers to provide more feedback and mention their version info as well. Thanks. $\endgroup$
    – Syed
    Feb 18 at 11:26

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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