4
$\begingroup$

How can I create a function that would have as its argument an array mat of 0s, 1s, and 2s where the 2s are burning trees and the function would give an array that represents the forest after one time step?

I have tried using

mat=RandomChoice[{0,1,2},{10,10}]
nextstep[mat_]:=Sequence[mat2 + {1, 0}, mat2 + {0, 1}, mat2 + {-1, 0}, mat2 + {0,-1}]

but that doesn't seem to work. After one time step, every tree, represented by 1s, that is in the von Neumann neighborhood of a burning tree would catch fire, but the 0s, which means there are no trees, would remain the same.

EDIT: How can I further develop this so as to have a function that has as its argument the array mat and can iterate nextstep, until the array doesn't change anymore? So, essentially this new function would return {mat, nextstep[mat], nextstep[nextstep[mat]],...}. I tried using finalstate[mat_]:=NestList[nextstep, mat, 5], but it's not returning what I'm looking for.

$\endgroup$
3
  • $\begingroup$ Have you seen this? $\endgroup$
    – J. M.'s torpor
    Jan 22 at 22:34
  • $\begingroup$ Yes I have seen it and I tried to construct my function from some of those answers, but I was still finding it difficult to do so @J.M. $\endgroup$
    – jbl
    Jan 22 at 23:39
  • 1
    $\begingroup$ For what it's worth, you might have a look at "level set methods" and in particular "fast marching" as a more general but related approach. $\endgroup$ Jan 23 at 22:42
3
$\begingroup$

Here is an example. First we need some data:

n = 5;
mat = RandomChoice[{0, 1, 2}, {n, n}];

Then we need a function that shifts a list to the left or right, filling the empty place with zeros. It is nearly the same functionality as RotateRight/Left, but we do not want it to be circular. Therefore we set the elements that are circulated to zero.

shiftr[m_] := Prepend[Rest[RotateRight[m]], 0 m[[1]]]
shiftl[m_] := Append[Most[RotateLeft[m]], 0 m[[1]]]

We define now a step: With the help of shiftr/l we shift the current matrix left/right/up/down and take the maximum at every position, that gives a matrix mat1 with 2 at all the shifted positions of 2's. Finally we imprint this shifted 2's onto the the matrix mat:

step[mat_] := (mat1 = 
    MapThread[
     Max, {shiftr[mat], shiftl[mat], shiftr /@ mat, shiftl /@ mat}, 
     2]; MapThread[If[#2 == 2, 2, #1] &, {mat, mat1}, 2]);

Now we apply this to our data:

mat // MatrixForm
(mat = step[mat]) // MatrixForm
(mat = step[mat]) // MatrixForm

enter image description here

$\endgroup$
4
  • $\begingroup$ is there a way of doing this but the 0s dont become 2s after one step? @DanielHuber $\endgroup$
    – jbl
    Jan 24 at 17:12
  • 1
    $\begingroup$ Sure, simply change stepto: step[mat_] := (mat1 = MapThread[ Max, {shiftr[mat], shiftl[mat], shiftr /@ mat, shiftl /@ mat}, 2]; MapThread[If[#2 == 2 && #1 == 1, 2, #1] &, {mat, mat1}, 2]); $\endgroup$ Jan 24 at 17:22
  • $\begingroup$ and then if i used something like NestList, could i potentially iterate this function, or matrix, until all the 1s become 2s? @DanielHuber $\endgroup$
    – jbl
    Jan 26 at 2:22
  • $\begingroup$ Yes, that's the idea, $\endgroup$ Jan 26 at 9:53
2
$\begingroup$
ClearAll[vNNeighbors, nextStep]
vNNeighbors[dim_] := AdjacencyList[NearestNeighborGraph @ Tuples @ Range @ dim, #]&

nextStep = MapAt[Min[2, 2 #] &, #, vNNeighbors[Dimensions @ #][Position[#, 2]]] &;

Example :

SeedRandom[1]
mat = RandomChoice[{0, 1, 2}, {10, 10}];

Row[MapThread[Labeled[#, #2, Top] &, 
   {MatrixForm /@ {mat /. 2 -> Highlighted[2], 
      nextStep[mat] /. 2 -> Highlighted[2, Background -> RGBColor[1, 0, 1]]}, 
   {Style["mat" , 16], Style["nextStep[mat]", 16]}}], Spacer[10]]

enter image description here

Use nextStep with NestList to simulate spreading of 2s in the initial matrix mat:

SeedRandom[1]
mat = RandomChoice[{49, 50, 1} -> {0, 1, 2}, {40, 40}];

timesteps = 60;

frames = MatrixPlot[# /. {0 -> White, 1 -> Green, 2 -> Red}, Mesh -> All, 
    ImageSize -> 400] & /@ NestList[nextStep, mat, timesteps];

ListAnimate[frames]

enter image description here

$\endgroup$
0
$\begingroup$

We can use Nearest to find the neighbors of a list of indices. This approach is more flexible in that we can use the option DistanceFunction to consider alternative definitions of neighbors.

ClearAll[nF, NN, nextStep]
nF[dims_, df_: Automatic] := Nearest[Tuples @ Range @ dims, DistanceFunction -> df]

NN[mat_, val_, df_: Automatic] := Join @@
  nF[Dimensions @ mat, df][Position[mat, val], {All, 1}]

nextStep[df_: Automatic] := MapAt[Min[2, 2 #] &, #, NN[#, 2, df]] &;

Default distance function Automatic ("EuclideanDistance") gives von Neumann neighbors and "ChessboardDistance" gives Moore neighbors.

Examples:

SeedRandom[1]
mat = RandomChoice[{0, 1, 2}, {10, 10}];

Row[MapThread[Labeled[#, #2, Top] &, {MatrixForm /@ 
    {mat /. 2 -> Highlighted[2], 
     nextStep[][mat] /. 2 -> Highlighted[2, Background -> Red], 
     nextStep["ChessboardDistance"][mat] /. 
          2 -> Highlighted[2, Background -> RGBColor[1, 0, 1]]}, 
   {Style["mat", 16], Style["nextStep[][mat]", 16], 
    Style["nextStep[\"ChessboardDistance\"][mat]", 16]}}], Spacer[10]]

enter image description here

SeedRandom[1]
mat = RandomChoice[{49, 50, 1} -> {0, 1, 2}, {40, 40}];

timesteps = 60;

frames1 = MatrixPlot[# /. {0 -> White, 1 -> Green, 2 -> Red}, Mesh -> All, 
     ImageSize -> 400, Frame -> False, 
     PlotLabel -> Style["EuclideanDistance", 16]] & /@ 
   NestList[nextStep[], mat, timesteps];

frames2 = MatrixPlot[# /. {0 -> White, 1 -> Green, 2 -> Purple}, Mesh -> All, 
     ImageSize -> 400, Frame -> False, 
     PlotLabel -> Style["ChessboardDistance", 16]] & /@ 
   NestList[nextStep["ChessboardDistance"], mat, timesteps];

frames = Row /@ Transpose[{frames1, frames2}];

ListAnimate[frames]

enter image description here

$\endgroup$

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.