Function representing a forest fire after one time step

Question

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.

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. — jbl, Jan 22 '21 at 23:39
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. — Daniel Lichtblau, Jan 23 '21 at 22:42

Daniel Huber · Accepted Answer · 2021-02-06T09:50:59.480

4

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

edited Feb 06 '21 at 09:50

answered Jan 23 '21 at 10:16

Daniel Huber

51,463
1
23
57

is there a way of doing this but the 0s dont become 2s after one step? @DanielHuber – jbl Jan 24 '21 at 17:12
1

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]); – Daniel Huber Jan 24 '21 at 17:22
and then if i used something like NestList, could i potentially iterate this function, or matrix, until all the 1s become 2s? @DanielHuber – jbl Jan 26 '21 at 02:22
Yes, that's the idea, – Daniel Huber Jan 26 '21 at 09:53

kglr · Answer 2 · 2021-02-06T09:09:47.050

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]]

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]

kglr · Answer 3 · 2021-02-12T03:17:58.037

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[&quot;ChessboardDistance&quot;][mat]", 16]}}], Spacer[10]]

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]

Function representing a forest fire after one time step

3 Answers3

Linked

Related