New answers tagged

3

Use {n} as the level spec to apply the function only to elements at level n. If you use n as the level spec, the function is applied to elements at levels 1 thru n. lst = {{{a, b}, {b, c}}, {{c, d}}} Map[f, lst, {3}] {{{f[a], f[b]}, {f[b], f[c]}}, {{f[c], f[d]}}} Map >> Details and Options:


5

Maybe something like: ClearAll[pictureTest, minTest, newFunc] pictureTest[z_] := RegionPlot[x >= z*y && {x, y} ∈ Tri, {x, 0, 1}, {y, 0, 1}] minTest[z_] := Minimize[{x, x >= y + z && {x, y} ∈ Tri}, {x, y}] You can use Through to get a list of results from applying a list of functions to a given input: newFunc[z_] := Through[{...


5

Order of definition matters, oddly enough. If you switch the order of definitions, things will work OK. I always define the specific cases first, then the general. ψ0[x_] := 1/(2 π)^(1/4) Exp[-(x^2/4) - I k x]; ψr[x_, 0] := ψ0[x]; ψr[x_?NumericQ, n_?NumericQ] := ψr[x, n] = NIntegrate[SK[y, x, Δt] (Projector[x]/ Sqrt[NIntegrate[Abs[Projector[x] ψr[x, n -...


5

You can also use the function LineScaledCoordinate (from the "GraphUtilities`" package) as follows: Needs["GraphUtilities`"] pnts = Table[{x, kLine[x]}, {x, 0, 10, 10^-3}]; n = 7; coords = LineScaledCoordinate[pnts, N@#] & /@ Subdivide[n] {{0, 18.75}, {1.78571, 17.8571}, {3.57143, 16.9643}, {5.35714, 16.0714}, {7.14286, 15.1786}, {8.21429, ...


6

Easy. This is the function of the arc length of the graph of kLine measured from the origin. L[y_] = Integrate[Sqrt[1 + kLine'[x]^2], {x, 0, y}, Assumptions -> y > 0]; Now one can obtain the point y such that L[y] equals a desired length with FindRoot: desiredlength = 8; y0 = y /. FindRoot[L[y] == desiredlength, {y, 0, 10}, Method -> "Brent"]; ...


6

A few customizations for the IntervalSlider and InputField controls: ClearAll[thumb, intSlider, inpField] thumb = Graphics[{#, Text[Style["▲", #, 16], Offset[{0, -20}, {0, 0}]], Text[Style[#2, 12], Offset[{0, -35}, {0, 0}]]}, ImageSize -> 20] &; intSlider[Dynamic[{x_, y_}], range_, opts___ : OptionsPattern[]] := IntervalSlider[Dynamic[{x, y}]...


3

One way is to use Minimize and Maximize with constraint. Need to make sure min is smaller than max, else you'll get unexpected results. Manipulate[ Module[{a, b}, Quiet@Grid[{ {"expression", "Min", "Max"}, {"a+b", First@Minimize[{a + b, minA < a < maxA && minB < b < maxB}, {a, b}], First@Maximize[{a + b, minA ...


1

ClearAll[tabulate] tabulate = Flatten[{#, Total[Join @@ UpperTriangularize[#2, 1]], Tr@#2, Total[Join @@ UpperTriangularize[#2, -1]]}] & @@@ # &; headers = {"home", "away", "1", "X", "2"}; TableForm[tabulate@data, TableHeadings -> {None, headers}] Grid[Prepend[tabulate@data, headers], Dividers -> {All, {All, 2 -> Thick}}]


2

Edit: ClearAll["Global`*"] A1 = 0; B1 = 1; del = -1.5 // Rationalize; g0 = 4.8 // Rationalize; del0 = 1.5 // Rationalize; ome = 40 // Rationalize; k1 = 0.1 // Rationalize; kex = 0.1 // Rationalize; kL = (k1 + kex)/2 - del0*(k1 - kex)/(2*ome); Gma = 0.5 // Rationalize; {a1, b1} = {a1, b1} /. Flatten@Solve[{I*del*a1 + I*g0*(1 - del/ome)*A1*Re[b1]*a1 + ...


1

A little large for a comment: Change the function definition as: f[t_, T_] := FunctionInterpolation[ Piecewise[{{0, 0 <= t <= T/4}, {1 - Sin[2*\[Pi]*t/T], T/4 <= t <= 3*T/4}, {2, 3*T/4 <= t <= T}}], {t, 0, T}, InterpolationOrder -> 10] Now this yields an Interpolation function. f[t, 10] And can be plotted. Plot[f[t, 10][...


3

Clear[x, xx, n, R, seq] Note that you cannot use x as both a variable and a function. Using xx for the function, xx[0] = x0; xx[n_] := xx[n] = R xx[n - 1] (1 - x); seq = xx /@ Range[0, 10] (* {x0, R (1 - x) x0, R^2 (1 - x)^2 x0, R^3 (1 - x)^3 x0, R^4 (1 - x)^4 x0, R^5 (1 - x)^5 x0, R^6 (1 - x)^6 x0, R^7 (1 - x)^7 x0, R^8 (1 - x)^8 x0, R^9 (1 - x)^9 ...


0

I cannot try this without the definition of the function $\alpha(a,b;c)$, but here's a general solution: Define the integral $A(c)=\int_{-\infty}^{\infty}\alpha(a,b;c)\,da\,db$: A[c_?NumericQ] := NIntegrate[α[a, b, c], {a, -∞, ∞}, {b, -∞, ∞}] You can plot $A(c)$ to get an idea of the desired solution $c$: Plot[A[c], {c, 0, 1}] You can find a numerical ...


1

Someone in QQ group(QQ: 2636051698 ) give me two answer. Replace[Unevaluated@ Unevaluated[ a <= -2 || (1 < a < 2 && (x >= 1/3 (4 + 4 a))) || a >= 2], statement : Except[_And] :> And[statement, True], {2}] /. (Or[a_ && b_]) :> {b, a} // List @@ # & // Piecewise or Replace[Hold[ a <= -2 || (1 < a < 2 ...


3

How about this? Replace[ a <= -2 || (1 < a < 2 && (x >= 1/3 (4 + 4 a))) || a >= 2, statement : Except[_And] :> Inactive[And][statement, True], {1} ] Note the necessity to use Inactive[And], since otherwise the True in And[..., True] will disappear immediately again. Also note that BooleanConvert can be useful to ensure that ...


1

We can use my code without changing for Z<=15000 l1 = 0.81; Z = 15000; x0 = 10; v0 = 0.02; \[Epsilon] = $MachineEpsilon; l0 = 0.0714`20.; ps = ParametricNDSolveValue[{y''[r] + 2 y'[r]/r == -4 \[Pi] l k Exp[-y[r]], y[\[Epsilon]] == y0, y'[\[Epsilon]] == 0, WhenEvent[r == 1, y'[r] -> y'[r] + Z l]}, {y, y'}, {r, \[Epsilon], R}, {k, l}, ...


2

At least for the OP's specific case, here is one possibility: Piecewise[Append[ KeyValueMap[{#2, #1} &, GroupBy[Cases[ BooleanConvert[Reduce[Sin[x^2] + Cos[a] == 0 && -π/2 <= x <= π/2, x], "DNF"], x == expr_ && ...


1

It's useful to have a test input on hand when taking apart code like the one in the OP. ff = Function[t, Piecewise[{{t/4, t < 0}, {t/2, t < 3}, {3/2 + (t - 3)*3, True}}]]; First (with a slight change of variables to help clarify the operations), Reduce[x == ff[y], y, Reals] (x <= 0 && y == 4 x) || (0 < x <= 3/2 && y == 2 ...


1

ClearAll[foo] foo = Module[{mat = #, max = Max[#], legends = #2, vlabels = Thread[Range[Length@#] -> #2], subgraphBetweenCRI, wecnt, windex, degcent, llp}, subgraphBetweenCRI = AdjacencyGraph[UnitStep[mat - #] (1 - UnitStep[mat - #2])] &; wecnt = #*EdgeCount[subgraphBetweenCRI[#, max]] &; windex = Sum[wecnt[t], {t, 0, max, 0.01}...


0

This is my answer to my own question, but still, I am not satisfied with it because I cannot give an index name for each matrix in out[...]. out[m_?MatrixQ] := { selectBetween[\[Theta]1_, \[Theta]2_] := BoolEval[\[Theta]1 <= m < \[Theta]2]; subgraphBetween[\[Theta]1_, \[Theta]2_] := AdjacencyGraph[selectBetween[\[Theta]1, \[Theta]2], ...


Top 50 recent answers are included