# How to implement the Nagel-Schreckenberg model in Mathematica

I want to implement the Nagel-Schreckenberg model with CellularAutomaton in Mathematica. I saw some code for the traffic model. But what I want is the most basic Nagel-Schreckenberg model. I hope someone will give me the code.

• Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Take the tour and check the faqs! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! – Carl Lange Aug 27 '19 at 10:17
• Since the Wikipedia page mentions that "For a maximum speed of one (instead of five) and no probability of slowing down, the model equals cellular automaton 184 by Stephen Wolfram." it might be best to start with something like CellularAutomaton[184, {1,0,0,1,1,1,1,0,0,0}, 50] (naturally, vary the initial condition and number of iterations to your heart's content) – Carl Lange Aug 27 '19 at 14:36
• Think you.But I don't know much about the update rules of the cellular automaton. I hope that you can help me write a code with a maximum velocity of 5 and a Randomization probability of 30%. – Wuyang Zhang Aug 28 '19 at 2:28
• I am sorry for my poor English .I am very appreciate the person who answered my question. – Wuyang Zhang Aug 28 '19 at 2:35

Here's my take on it. As far as I can tell, the type of rules that are involved in the Nagel-Schreckenberg model cannot be implemented with CellularAutomaton, so I had to resort to a different approach.

accelerate[map_] := Replace[
map,
speed_?NonNegative :> Min[5, speed + 1],
{1}
]

slow[map_] := Replace[
Partition[map, 6, 1, {1, 1}], {
{v_?NonNegative, empty : Longest[-1 ...], ___} :>
Min[v, Length[{empty}]],
{-1, ___} :> -1
},
{1}
]

slowRandom[map_, p_] := Replace[
map,
speed_?Positive :> RandomChoice[{1 - p, p} -> {speed, speed - 1}],
{1}
]

move[map_, n_] := Module[{pos},
pos = Position[Partition[map, n + 1, 1, {1, 1}], {n, -1 ..}];
ReplacePart[
map,
]
]

iterate[map_, p_] := RightComposition[
accelerate,
slow,
slowRandom[#, p] &,
Fold[move, #, Range] &
]@map


Here is how you can run a simulation with density 0.35 and $$p=0.3$$, like in that image on Wikipedia:

map = RandomChoice[{0.65, 0.35} -> {-1, 0}, 100];
data = NestList[iterate[#, 0.3] &, map, 100];
ArrayPlot[data, ColorRules -> {-1 -> White, _ -> Black}] In this picture, empty cells are white, and cars are black.

If you found this interesting, you may also want to check out my implementation of the Levine-Middleton-Biham traffic model, another cellular automaton, here.

• I sincerely thank you, I will study this code well, I can not image that the first time I sent a question, someone will help me answer. Few people in China's domestic mathematica will help answer. – Wuyang Zhang Sep 4 '19 at 12:10