Message Boards

WOLFRAM COMMUNITY

9786 Views

4 Replies

4 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Mathematics Physics

Animation of a Random Walk on a lattice

Philipp Krönert

Posted 10 years ago

Hi there, I started a small project. I tried to animate a Random Walk on a 2 dimensional lattice. I set the starting point: list = {{0, 0}}; The Random Walk is performed by: For[i = 2, i <= 100, i++, list = Append[list,list[[i - 1]] + RandomChoice[{{0, 0}, {0, 1}, {1, 0}, {0, -1}, {-1,0}}]]] The animation is done by this piece of code: ListAnimate[Table[ListLinePlot[Take[list, i],Mesh -> All, MeshStyle -> {Red, Thick}, ColorFunction -> Hue], {i,Length[list2]}], AnimationRate -> 4] This code performs an animated Random Walk. Now i try to bring more transparency into each single step. Does someone has an idea how to improve the code in such a way, that every single step will be highlighted? Thank you for your ideas! Cheers Philipp

POSTED BY: Philipp Krönert

4 Replies

Sort By:

Henrik Schachner

Henrik Schachner, Radiation Therapy Center, Weilheim, Germany

Posted 10 years ago

Hi Philipp, try this (the code - I think - explains itself): ClearAll["Global`*"] numberOfSteps = 1000; startingPostion = {0, 0}; randomStep = Table[RandomChoice[{{0, 0}, {0, 1}, {1, 0}, {0, -1}, {-1, 0}}], {n, numberOfSteps}]; randomPosition = Prepend[Accumulate[randomStep], startingPostion]; randomLines = Partition[randomPosition, 2, 1]; Manipulate[ Graphics[{{Green, Line[randomLines[[n + 1 ;;]]]}, {Blue, Thick, Line[randomLines[[;; n - 1]]]}, {Red, Thick, Arrow[randomLines[[n]]]}}, Axes -> True, ImageSize -> Large], {n, 1, numberOfSteps, 1}] As a discreet remark: If possible try to avoid looping constructs (like "For[ ]") as this does not agree very well with the programming paradigm of Mathematica. Cheers Henrik

Hi Philipp,

try this (the code - I think - explains itself):

ClearAll["Global`*"]

numberOfSteps = 1000;
startingPostion = {0, 0};

randomStep = 
  Table[RandomChoice[{{0, 0}, {0, 1}, {1, 0}, {0, -1}, {-1, 0}}], {n, 
    numberOfSteps}];
randomPosition = Prepend[Accumulate[randomStep], startingPostion];
randomLines = Partition[randomPosition, 2, 1];
Manipulate[
 Graphics[{{Green, Line[randomLines[[n + 1 ;;]]]}, {Blue, Thick, 
    Line[randomLines[[;; n - 1]]]}, {Red, Thick, 
    Arrow[randomLines[[n]]]}}, Axes -> True, ImageSize -> Large], {n, 
  1, numberOfSteps, 1}]

As a discreet remark: If possible try to avoid looping constructs (like "For[ ]") as this does not agree very well with the programming paradigm of Mathematica.

Cheers Henrik

POSTED BY: Henrik Schachner

Philipp Krönert

Posted 10 years ago

Wow, that's great! Thank you Henrik.

POSTED BY: Philipp Krönert

Szabolcs Horvát

Posted 6 years ago

Here's a random walk animation on a fancy lattice, done with the help of IGraph/M. << IGraphM` (* IGraph/M 0.3.99.1 (May 1, 2018) Evaluate IGDocumentation[] to get started. *) lattice = IGLatticeMesh["Herringbone"] graph = IGMeshCellAdjacencyGraph[lattice, 2, VertexCoordinates -> Automatic] walk = IGRandomWalk[graph, First@VertexList[graph], 200] len = 8; colors = Reverse@NestList[Lighter, Red, len - 1]; MeshRegion[lattice, MeshCellStyle -> Thread[# -> colors]] & /@ Partition[walk, len, 1] // ListAnimate

Here's a random walk animation on a fancy lattice, done with the help of IGraph/M.

<< IGraphM`

(* IGraph/M 0.3.99.1 (May 1, 2018)

Evaluate IGDocumentation[] to get started. *)

lattice = IGLatticeMesh["Herringbone"]

graph = IGMeshCellAdjacencyGraph[lattice, 2, VertexCoordinates -> Automatic]

walk = IGRandomWalk[graph, First@VertexList[graph], 200]

len = 8;
colors = Reverse@NestList[Lighter, Red, len - 1];
MeshRegion[lattice, MeshCellStyle -> Thread[# -> colors]] & /@ Partition[walk, len, 1] // ListAnimate

enter image description here

POSTED BY: Szabolcs Horvát

Raspi Rascal

Raspi Rascal, novato, contributor, pseudo-wannabe (not even tryhard)

Posted 6 years ago

Maybe more intriguing the following pseudo-animation of a random lattice walk including some interactivity. The code is based on an example from a WTC talk held by Lou D'Andria on $Manipulate[]$ almost 15 years ago. Manipulate[ dirs = {{1, 0}, {0, 1}, {-1, 0}, {0, -1}} ; rwinit = {{0, 0}} ; Graphics[ {{Opacity[0.33], Dynamic@Line[ If[! paused , AppendTo[rw, Last[rw] + stepsizeRandomChoice[dirs]] , rw]]} , Red, PointSize[Large], Dynamic@Point[Last[rw]] }, PlotRange -> All] , {{rw, rwinit}, ControlType -> None} ( InputField[], made invisible ) , {stepsize, Range[10]} ( PopupMenu[] ) , {paused, {False, True}} ( Checkbox[] *) ]

Maybe more intriguing the following pseudo-animation of a random lattice walk including some interactivity. The code is based on an example from a WTC talk held by Lou D'Andria on $Manipulate[]$ almost 15 years ago.

Manipulate[
 dirs = {{1, 0}, {0, 1}, {-1, 0}, {0, -1}}
 ; rwinit = {{0, 0}}
 ; Graphics[
  {{Opacity[0.33], Dynamic@Line[
      If[! paused
       , AppendTo[rw, Last[rw] + stepsize*RandomChoice[dirs]]
       , rw]]}
   , Red, PointSize[Large], Dynamic@Point[Last[rw]]
   }, PlotRange -> All]
 , {{rw, rwinit}, ControlType -> None} (* InputField[], made invisible *)
 , {stepsize, Range[10]} (* PopupMenu[] *)
 , {paused, {False, True}} (* Checkbox[] *)
 ]

POSTED BY: Raspi Rascal

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Group Abstract

Feedback