37

If it is at all an option to represent the grid as a 2D list instead of a list of infected coordinates, I would model this is a cellular automaton. What you've essentially got is an outer totalistic cellular automaton with a von Neumann neighbourhood. The rule in Game-of-Life notation is B234/S01234, i.e. a cell comes to life if it has two or more live ...


25

This is just a long comment trying to shed light on where the problem may be coming from. Since version 10.2, the following is valid syntax: Table[x, 5] Before we could only use Table[x, {5}] or Table[x, {i, 5}] This implies that we should expect the following to work too: n=5; Table[x, n] the same way as Table[x, {n}] or Table[x, {i, 1, n}] work ...


18

Based on some geometric operations such as reflection and line-line intersection (LLI), I wrote up a small code. Hope this could be a starting point to build a more compact NestList-based solution. LLI returns the intersection point between two line segments, {p0,p1} and {q0,q1}, coded in the list vi = {p0, p1, q0, q1} LLI[vi_List] := With[{ x1 = vi[[1, ...


15

What you actually want is to create a Sequence from the Table to be used as your iterators. You can do this with Do[Print[B[0] + B[1] + B[2]], Sequence @@ Table[{B[i], 0, i}, {i, 0, 2}] // Evaluate] (*0 1 2 1 2 3*) Or, so you don't have to force evaluation, Do[Print[B[0] + B[1] + B[2]], ##] & @@ Table[{B[i], 0, i}, {i, 0, 2}]


14

This is an evaluation order issue. x and f need to expand (evaluate) to {a, b, c} and {3, 5, 2} for Thread to work Table has attribute HoldAll which prevents its arguments form evaluating first Specific evaluation of Table (before Thread) should be suppressed to avoid warning messages Holding Table gets around each of these points: x = {a, b, c}; f = {3, 5,...


13

As Bob Hanlon's answer points out, RecurrenceTable does not hold its arguments, but most especially, it does not hold its iterator arguments. This must surely be viewed as a bug as it departs completely from the iterator idiom established by Table, etc. On the other hand, there is precedent for evaluating the iterator specifications. For example, ...


12

Non CellularAutomaton solution, using @MartinEnder's suggestion of FixedPointList as opposed to NestWhileList: f[initial_List, infected_List, rest_List] := With[{newinfected = Join[infected, Select[Thread@{rest, Thread@Table[EuclideanDistance[infected[[t]], #] & /@ rest, {t, Length@infected}]}, Count[#[[2]], 1] > 1 &][[All, 1]]]}, {...


12

x = {1, 2, 3, 4}; y = {0, 1, 2, 5}; Listable >> Properties and Relations: "A function implemented in terms of a listable operation may not need the Listable attribute:" Since f is defined in terms of Listable operations (Plus and Power) it automatically threads over list arguments. So you can simply use f[x,y] for list inputs x and y: f[x_,y_] := x^2+y ...


11

Unlike many other functions that use an iterator, RecurrenceTable does not have the attribute HoldAll. Presumably, this indicates a different evaluation sequence (Evaluation in Iteration Functions). Grid[ Prepend[ {#, Attributes[#]} & /@ {Do, Product, Sum, Table, RecurrenceTable}, Style[#, Bold] & /@ {"Function", "Attributes"}], Frame -> ...


11

Instead of thinking too hard, we can let NDSolve take care of it, using WhenEvent to handle the reflections. First, set up 3 lines to define the arena: {m1, b1} = {2, 0}; {m2, b2} = {-1, 1}; {m3, b3} = {0, 0}; reg = Plot[{m1 x + b1, m2 x + b2, m3 x + b3}, {x, 0, 1}, PlotRange -> {-0.01, 2/3}] Then ReflectionTransformation to code the reflections (...


10

Here an approach that uses some Dataset related functionality. Doesn't look too readable to me, but in its core it uses the column names to access the data-set and things like Keys and Values. Everything can be found in the documentation of Dataset: d = Dataset[{<|"X" -> 0., "N" -> 14, "S" -> 106.85, "M0" -> 8962.85, "M1" -> 129.71|&...


9

Well, as others have said, you could use Orthogonalize to solve this problem, and it will likely be the fastest way to do so, but let's assume that (for whatever reason) you don't want to use Orthogonalize. I'll assume it's something of a learning exercise, so we'll create a function (which I end up calling gsOrthognalize), and we want to pass to it a list ...


8

i = Module[{k = 100000, m = 5, data, dt, t}, data = (dt = .0001 + .0005 #; t = -dt; NestList[{Cos[4 #[[2]]] Cos[t += dt], Sin[#[[1]]] Sin[t]} &, RandomReal[{0, 2 π}, 2], k]) & /@ Range[0, m]; ListPlot[data, AspectRatio -> 1, PlotRange -> {{-1, 1}, .5 {-1, 1}}, Axes->None, ...


8

I think there maybe be a sign error in the maths, bear with me. Given your V[x_, y_] := 1/2 (x^2 + y^2) - y (1/3 y^2 - x^2) we can find the partial derivatives: Vx = D[V[x, y], x] Vy = D[V[x, y], y] Vxx = D[V[x, y], {x, 2}] Vyy = D[V[x, y], {y, 2}] Vxy = D[V[x, y], x, y] Vyx = D[V[x, y], y, x] sol = Solve[{Vx == 0, Vy == ...


8

Several changes are required to obtain the desired results. First, the syntax error mu[n] == mu must be replaced by mu[n] = mu. Next, initial conditions must be provided for the recurrence in n: mu[0] := mu /. FindRoot[f[1/2, mu, 2^0] == 1/2, {mu, 0.9}] mu[1] := mu /. FindRoot[f[1/2, mu, 2^1] == 1/2, {mu, 0.9}] mu[2] := mu /. FindRoot[f[1/2, mu, 2^2] == 1/...


8

You need to use SlotSequence (##) in place of Slot (#). # refers to the first element (in your case to {a, 0, 4}) in a sequence of slots. Table[iterator[[All, 1]], ##] & @@ iterator {{{0, 0}, {0, 1}, {0, 2}, {0, 3}, {0, 4}, {0, 5}}, {{1, 0}, {1, 1}, {1, 2}, {1, 3}, {1, 4}, {1, 5}}, {{2, 0}, {2, 1}, {2, 2}, {2, 3}, {2, 4}, {2, 5}}...


8

Update: Animation of fire-spreading: ClearAll[initState, vNNeighbors, step, iterationList] initState[b_, i_, j_, pos_: Automatic] := ReplacePart[ RandomChoice[{1/(1 + b), b/(1 + b)} -> {0, 1}, {i, j}], (pos /. Automatic -> RandomChoice[Tuples[{Range@i, Range@j}]]) -> 2] vNNeighbors[dim_: {30, 30}] := AdjacencyList[NearestNeighborGraph@Tuples@...


8

I found your simulation idea interesting, so I decided to look into the problem. What I found was that your implementation of nextState is mostly where the fault lies. It simply does not do what it name advertises — it does not compute the next state of the simulated world. Here is the code I used to develop a working simulation. I use a more modular ...


7

You can do this without Table: g[k_] := k^2 + 1 Map[If[# != 6, f[#] = g[#], f[#] = 1] &, Range[10]] {2, 5, 10, 17, 26, 1, 50, 65, 82, 101} You can also use Scan in place of Map (it may be slightly faster for large lists). Note that no result will be displayed, but f will still retain the values stored in it. Scan[If[# != 6, f[#] = g[#], f[#] = 1] &...


7

A scan operation doesn't really have an index, but you can get the effect you want by introducing a counter. Module[{i = 0}, Scan[(i++; Print[i, ", ", #]) &, {2, 5, 7}]] You might also consider using Do, which does have an index. With[{data = {2, 5, 7}}, Do[Print[i, ", ", data[[i]]], {i, Length @ data}]]


7

You can use FixedPoint: FixedPoint[Log[3.5 #] &, 3.5] == -ProductLog[-1, -1/3.5] True In general, if $y = f(f(...f(f(...))))$, then $y = f(y)$. Solving for $y$ will give us the formula for the infinitely nested expression. In your case, f == Log[x #]&, which gives sol = Refine[Reduce[y == Log[x y], y], x > 0] Unfortunately FullSimplify can't ...


7

Using the shortcut //. together with a MaxIterations options s //. Sequence[s -> s (1 + r), MaxIterations -> 3] $\ $(1 + r)^3 s or s //. (s -> s (1 + r)) ~ Sequence ~ (MaxIterations -> 3) An example for an efficient looping construct using ReplaceRepeated is the pattern matching Fibonacci sequence generator fiboSequence2[n_] := Quiet@...


7

As Michael Witt has mentioned this is mainly interesting as a learning exercise as there is Orthogonalize. As such, I think it is worth mentioning that it is quite easy to do this a lot more efficient by simplifying each row before calculating the next row which will keep the underlying expressions a lot simpler and smaller. Here is code which does do that (...


7

Indeed, the existing notebook can be called repeatedly from another notebook, which iterates over the desired parameters, passing them to the existing notebook, which then passes the answers back to the calling notebook, which records them. For instance, begin the calling notebook with Dynamic[{loop, linked`vdtdz}] distab = {}; Dynamic[distab // TableForm] ...


7

The demonstration of CellularAutomaton is impressive but it is far from necessary for this problem. I propose ListCorrelate instead. Keeping much of Martin Ender's code for ease of comparison: d = 25; a = RandomChoice[{7, 1} -> {0, 1}, {d, d}]; ker = {{0, 1, 0}, {1, 2, 1}, {0, 1, 0}}; fn = UnitStep[ListCorrelate[ker, #, 2, 0] - 2] &;...


7

Perhaps you can avoid Do and instead use Tuples: Tuples @ Range[0, {0, 1, 2}] {{0, 0, 0}, {0, 0, 1}, {0, 0, 2}, {0, 1, 0}, {0, 1, 1}, {0, 1, 2}} You can then use Total to sum each tuple: Total[ Tuples @ Range[0, {0, 1, 2}], {2} ] {0, 1, 2, 1, 2, 3}


7

Welcome to MMA SE! (Note that I think you shouldn't be using Evaluate there: consider i=3; Do2[Print[i], {i,5}].) Syntax highlighting is done in terms of the syntax only, and the front end's processing of that syntax; the downvalue of Do2 (that is, the definition you gave it via :=) is not a syntactic property the front end can access. But there is a way to ...


6

There are two easy approaches that come to mind. The first is to simply use MapThread. MapThread[foo, {Range[0, 4], Range[24, 32, 2]}] {foo[0, 24], foo[1, 26], foo[2, 28], foo[3, 30], foo[4, 32]} If you are collecting all results this is probably a perfectly good approach as memory is unlikely to be a problem. The second is to define the relationship ...


6

Based on your code, we can first create a function PoAGen to generate mean PoA values as follows: Clear[PoAGen] PoAGen[nodes_, links_, n_: 1000] := Module[ {an = 10, al = 1, s, M, id, od, wd, x, poa, PoA}, Cases[_?NumericQ]@ Table[s = DirectedGraph[RandomGraph[{nodes, links}], "Acyclic"]; M = al*Transpose[AdjacencyMatrix[s]]; id = an + al*VertexInDegree[s]...


6

To get the data arranged for use in ListPlot, you'll have to use 'Normal - e.g. like this: data = Transpose[Normal[Map[Values, Dataset[{<|"X" -> 0., "N" -> 14, "S" -> 106.85, "M0" -> 8962.85, "M1" -> 129.71|>, <|"X" -> 0.5, "N" -> 14, "S" -> 104.81, "M0" -> 8956.78, "M1" -> 135.78|>, <|"X" -...


Only top voted, non community-wiki answers of a minimum length are eligible