Hot answers tagged

9

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" -> ...


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, ...


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[#] = ...


7

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


7

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


6

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


6

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


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 + ...


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" ...


6

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_] := ...


6

The error message does not come from your own Do loop, but from a Do loop inside the PerfectNumber code somewhere: In[9]:= PerfectNumber[mmVerbose] During evaluation of In[9]:= Do::iterb: Iterator ...


6

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


5

Plot has attributes, HoldAll, so the Sum isn't evaluated, try this: Plot[Evaluate[Sum[a^10*(-1)^(x - a), {a, 1, x}]], {x, 1, 10}] Where the sum evaluates to: before plotting: related questions/answers: Difference in Plot when using Evaluate vs when not using Evaluate How and when to use Evaluate? Behavior of expression evaluation in Plot I ...


5

Use With: Table[With[{v = varx[[i]]}, D[#1, v] &], {i, 3}]` (* {D[#1, x1] & , D[#1, x2] & , D[#1, x3] & } *) See the section "Scope" of the documentation page for With. Note that Function (&) has the attribute HoldAll, so that the value of varx[[i]] needs to be inserted into the function. The above gives a list of operators. An ...


5

Table has attribute HoldAll. This means its arguments are left unevaluated: Attributes[Table] (* {HoldAll, Protected} *) Using an Evaluate will force the evaluation order to be as you desire: x = {i, 5}; Table[i, Evaluate@x] (* {1, 2, 3, 4, 5} *)


5

MapIndexed[Print[Row[{First@#2, #1}, ","]] &, {2, 5, 7}]; 1,2 2,5 3,7 Or simpler: MapIndexed[Print[First@#2, ",", #1] &, {2, 5, 7}] 1,2 2,5 3,7


5

sol0 = NSolve[{f, g, h}, {x, y, z}, Reals] rules = MapIndexed[# -> #2[[1]] &, {x, y, z} /. sol0] data = Quiet[ Function[{x0, y0, z0}, {x0, y0, z0, x, y, z} /. FindRoot[{f, g, h}, {x, x0}, {y, y0}, {z, z0}]] @@@ ICs] data2 = Flatten /@ Replace[Partition[#, 3] & /@ data, ({l1_, l2_} /; Chop@Total[(l2 - #)^2] == 0 :> {l1, #2} ...


4

There may be a better way to approach this problem. If you transform your function f[t] into the frequency domain ft[w], convolution becomes multiplication, and the iterative convolution of f[t] with itself becomes raising ft[w] to a power. Here is a simple example where f[t_] := Exp[-t^2/2]; ft[w_] := FourierTransform[f[t], t, w] Now you can plot the ...


4

Maybe this will do what you want ClearAll[q] q[1, B_, A_, f_] := f q[n_ /; n > 1, B_, A_, f_] := Block[{\[Omega]}, q[n, B, A, f] = Function[x, Evaluate[ Integrate[ q[n - 1, B, A, f][\[Omega]] f[x - \[Omega]], {\[Omega], B, A}]] ] ] Plotting q2 will now be very fast, as Mathematica will evaluate the integral for q2 to a ...


4

chainTable[expr_, itr : {sym_, __?NumericQ | {__}} ..] := Apply[Join, Map[Function[Null, Table[expr, #], HoldAll], Unevaluated@{itr}]]; SetAttributes[chainTable, HoldAll]; (* As per Jacob's comment *) chainTable[x^2, {x, 1, 9}] {1, 4, 9, 16, 25, 36, 49, 64, 81} chainTable[x^2, {x, 1, 9}, {x, 10, 90, 10}] {1, 4, 9, 16, 25, 36, 49, 64, 81, 100, 400, 900, ...


4

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


4

In addition to RunnyKine's recommendation of If here are two other methods to consider. 1: Unset or restore the value Simply Unset f[6] afterward: Do[f[k] = g[k], {k, 10}]; f[6] =. Array[f, 10] {g[1], g[2], g[3], g[4], g[5], f[6], g[7], g[8], g[9], g[10]} Note f[6] is returned as it is undefined. Or if f[6] already has a value save and restore it: ...


4

Of course you can use the If also inside the table: Table[If[k != 6, f[k] = g[k], f[k] = 1], {k, 10}] You can also use the If on the right hand side of the assignment: Table[f[k] = If[k != 6, g[k], 1], {k, 10}] If the whole purpose of the table is the assignment, that is you are not really interested in the list it outputs, you can replace Table with ...


4

functionList = {Sin[x], x^2, Exp[x], x^3}; nodes = {0, 1, 2, 3, 4}; f[x_] = Piecewise[Transpose[{functionList, #1 <= x <= #2 & @@@ Partition[nodes, 2, 1]}]] Plot[f[x], {x, 0, 4}]


4

Here's a way that allows you to specify the colors of each interval. colors={Red, Blue, Green, Orange}; Show[Thread[ p[functionList, Partition[nodes, 2, 1] /. {a_, b_} :> {x, a, b}, Thread[PlotStyle -> colors]]] /. p -> Plot, PlotRange -> Automatic]


4

Using Sjoerd's example: functionList = {Sin[x], x^2, Exp[x], x^3}; nodes = {0, 1, 2, 3, 4}; Plot[Evaluate@MapThread[ConditionalExpression, {functionList,Thread[Most @ nodes < x <= Rest @ nodes]}],{x,0,4}] or Plot[Evaluate@Thread[ConditionalExpression@@ {functionList,Thread[Most @ nodes < x <= ...


4

Here we go using FoldList list = Array[{Subscript[a, #], Subscript[b, #]} &, {3, 1}] // Flatten /@ # & (* or Flatten[#,1]& doing the same, but faster *) FoldList[f[#, Sequence @@ #2]&, x, list] EDIT, according suggestion from Shutao Tang to create the initial list in a more elegant and efficient way: list={Subscript[a, #], ...


4

I'll present an answer that doesn't require us to first convert the whole Dataset via Normal and then applying ListLinePlot. Instead, we collect the Keys and use the Dataset query approach. (* Here ds is the Dataset *) keys = Normal@Keys[ds][1]; (* The Column names of the Dataset *) {first, rest} = {First@keys, Rest@keys}; (* separating the columns of ...


4

Here is the solution of a possible interpretation of your question. Clear[a, b, c, n, sol] First solve the equation with unspecified parameters a, b, and c: (The plus minus in the OP sign is incorporated in the parameter b): sol = Solve[c == a Sqrt[1 - n] + b Sqrt[n], n] (* Out[919]= {{n -> (a^4 + a^2 b^2 - a^2 c^2 + b^2 c^2 - 2 Sqrt[a^4 b^2 c^2 ...


4

There are many questions about the Collatz sequence on this site, for example here. I interpret your question to ask for the smallest integer n that, after 125 iterations, has not settled into the 4-2-1 loop that is conjectured to terminate all Collatz iterations. You can run 125 iterations and return the result with the following definition. ...



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