Tag Info

New answers tagged

1

Rearrange and simplify the terms to find $ArcCos[X/3200] = 9$ and then take the cosine of each side to find $X = 3200 Cos[9]$.


1

You can try NSolve since this is non-linear. But it might not be able to solve it. Find root can. Also, if you know range of solution expected, it might help. m = 3; A0 = RandomReal[{0, 1}, {m, m}]; B0 = RandomReal[{0, 1}, {m, m}]; x = {x1, x2, x3}; C0 = RandomReal[{0, 1}, m]; eq = Thread[A0.x + B0.Exp[x] == C0]; FindRoot[eq, {{x1, 0}, {x2, 0}, {x3, ...


1

Generally: Yes, as long as you actually give the matrices a and b, as well as the vector c. With their elements named as usual x={x1,x2} etc., you then just do: Solve[a.x + b.Exp[x] == c,{x1,x2}] Example: With a={{1,0},{0,1}}, b={{0,1},{1,0}}, c={c1,c2}, x={x1,x2} this will give you the solution: {{x1 -> -I \[Pi] + Log[-c2 + x2]}} i.e.: you are ...


3

There are two ways to do this. One easy way is to use the Solve function: Solve[(40 + 50 I) x - 70 y == 130 && -40 x + (170 - 50 I) y == 0, {x, y}] {{x -> 6/5 - (11 I)/5, y -> 2/5 - (2 I)/5}} Or, if you must use matrices, you can solve an equation like ax=b by using matrix inverse. Solving for x, x=Inverse[a].b, where the dot is the matrix ...


1

One method is to write as xr+I*xi, where xr is the real part and xi is the imaginary part. Then Reduce[{(40 + 50 I) (xr + I xi) - 70 (yr + I yi) == 130, -40 (xr + I xi) + (170 - 50 I) (yr + I yi) == 0, {xr, xi, yr, yi} \[Element] Reals}, {xr, xi}] gives yr == 2/5 && yi == -(2/5) && xr == 6/5 && xi == -(11/5) and if you plug ...


2

Your equations have several syntax errors. _X_ is not a legal variable, I must be used instead of i, and == used instead of =. With these changes, NSolve[{(40 + 50 I) x - 70 y == 130, -40 x + (170 - 50 I) y == 0}, {x, y}] gives the desired answer. {{x -> 1.2 - 2.2 I, y -> 0.4 - 0.4 I}} As Jens commented, please review Mathematica documentation. ...


10

It is a bug in Reduce. It affects cases when the input contains a univariate equation f==g inside the ForAll quantifier, f-g is not an explicit polynomial, and Together[f-g] is zero. Thank you for pointing it out.


1

Your answers are correct. The first two solutions occur "at infinity" but your last two (after Chop) are {x->-4, y->0} and {x->0, y->0}, as is correct.


2

There are excellent answers of kguler and belisarius. Not to compete with them, but to offer a different view, you might operate within a different paradigm. Here it is: Step 1: Let us first find the solution of your equation for J: sl = Solve[16 x^3 - 4 x^2 + J^2/64 == 0, J] (* {{J -> -16 Sqrt[x^2 - 4 x^3]}, {J -> 16 Sqrt[x^2 - 4 x^3]}} *) ...


1

Perhaps Series[ToRadicals@Root[j^2 - 256 #1^2 + 1024 #1^3 &, 2], {j, 0, 4}]


0

Notice that everything depends on J1. Can we find J1? result1 = (J1 == 1/2 (((1 + α1^2)/β1) xβ1^2 + 2 α1* xβ1 xβ1PRIME + β1 xβ1PRIME^2)) //. {xβ1 -> -η1 δ1 + Sqrt[2 J1 β1] Cos[μ1], xβ2 -> -η2 δ2 + Sqrt[2 J1 β2] Cos[μ2], xβ1PRIME -> -η1PRIME δ1 - Sqrt[(2 J1)/β1] (α1* Cos[μ1] + Sin[μ1]), xβ2PRIME -> -η2PRIME δ2 - Sqrt[(2 J1)/β2] (α2* ...


1

These are not equations, they are assignments (or definitions) and you are defining Subscript[x, β2] in terms of Subscript[J, 2] while simultaneously defining Subscript[J, 2] in terms of Subscript[x, β2]. This causes infinite recursion.


2

Eliminate uses the given set of equations to eliminate the requested variables from those equations, returning the equations not needed to do the eliminations. Thus, Eliminate[{left[-l] == box[-l] && dbox[l] == dright[l] && right[l] == box[l] && dleft[-l] == dbox[-l]}, {a, b}, InverseFunctions -> True] eliminates variable ...


2

@belisarius recommended I make use of the WhenEvent[] function in the original NDSolve[] that produced my interpolating function. Since my NDSolve command finds y[t], but I am looking for solutions to an equation involving f[t], which is not defined until later, I cannot implement this suggestion in a completely straightforward fashion. However, it happens ...


0

Use a starting point to the left of the desired solution: FindRoot[f[t], {t,0}] or FindRoot[f[t], {t,10^7}] of course whatever is the leftmost point defined for your interpolating function.


1

Outline As you didn't provide boundary and initial conditions and the function pa'[t] this solution must be generic. Your equation for p[u,t] is linear (I guess pa'(t) means D[p[u,t],u]/.u->a) and can therefore be solved by standard mathematical methods once you provide the boundary and initial conditions. Physically it describes diffusion in a cylinder. A ...


1

A = {{0.1, 0}, {0, 0.1}}; B = {{2, 3}, {-3, 1}}; c = {{0.2, 0.6}, {0.2, 0}}; d = {2, 3}; e = {1, 0}; i = {{1, 0}, {0, 1}}; g[11] = {0, 0}; g[t_] := A.S[t+1].Inverse[i-B.S[t+1]].(B.g[t+1]-d)+A.g[t+1]+e; p[11] = {0, 0}; p[t_] := S[t].X[t] - g[t]; S[11] = {{0, 0}, {0, 0}}; S[t_] := c + A.S[t + 1].Inverse[i - B*S[t + 1]].A ; X[1] = {1, 0}; X[t_] := Inverse[i - ...


1

a = {{a1, a2}, {a3, a4}}; b = {{b1, b2}, {b3, b4}}; c = {{c1, c2}, {c3, c4}}; s[11] = {{0, 0}, {0, 0}}; s[10] = c + a.s[11].Inverse[IdentityMatrix[2] - b.s[11]].a which immediately returns {{c1, c2}, {c3, c4}} Trying to use upper case characters, like C, for variable names results in errors. Trying to use "abstract" vectors and matricies results in ...


2

With a = {{0.1, 0}, {0, 0.1}}; b = {{2, 3}, {-3, 1}}; c = {{0.2, 0.6}, {0.2, 0}}; i = {{1, 0}, {0, 1}}; and s[t_] := {{s11[t], s12[t]}, {s21[t], s22[t]}} one can see that s12 and s21 don't depend on t by evaluating c + a*s[t + 1]*Inverse[i - b*s[t + 1]]*a Therefore I set s[11] = {{0, 0.6}, {0.2, 0}} Redefining s with s[t_] := s[t] = c + a*s[t ...


0

A way to solve this is making the following change the fourth line into b = b /. {Subscript[be, 1] -> 1, Subscript[be, k_] :> (-1)*Subscript[be, k] /; k > 1} where we have taken the negative one out the Subscript function. This came from the kind comment by @bills that Subscript is mostly a formatting function whose output can become the ...


2

Your argument concluding that (a c)/(a + b) is a root but (a c)/(a - b) is not a root is not sound. You accept that (a c)/(a + b) is a root because your equation is satisfied by the triple {a, b, c} = {2, 3, 4}. However, it immediately follows that (a c)/(a - b) has the same value when {a, b, c} = {2, -3, 4}. So by your own reasoning you should accept (a ...


4

You can try using the option MaxExtraConditions Solve gives generic solutions only. Solutions that are valid only when continuous parameters satisfy equations are removed. Additional solutions can be obtained by using nondefault settings for MaxExtraConditions. Solve[-(c - x)/Sqrt[b^2 + (c - x)^2] + x/Sqrt[a^2 + x^2] == 0, x, ...


1

The curve in the Question, or more precisely the upper half of it, also can be obtained using InverseFunction Plot[InverseFunction[rd, 2, 2][x, 2.], {x, -3, 3}, PlotRange -> {0, 3}, AxesLabel -> {x, y}] Unfortunately, attempting to find the discontinuity in the slope by direct computation is both slow and noisy. Plot[D[InverseFunction[rd, 2, ...


1

I expect you are after something more general, but for this case we can analyze the lines generated by contourplot: (I dont have RegionDistance but this should be the same ) rd[x_?NumericQ, y_?NumericQ] := Min[EuclideanDistance[{x, y}, #] & /@ {{-1, 0}, {1, 0}}]; points = List @@ First@Cases[ Normal@First@ Cases[ ContourPlot[ ...


1

Its not really clear what you are asking, but here is a cleaned up version of your code: L = 1; dphi[v_] := ( s = f[x] /. First@NDSolve[ {f''[x] == v^2/f[x]^3 - f[x] (1 - f[x]^2), f[0] == f[L] == 1}, f[x], x, Method -> {"Shooting", "StartingInitialConditions" -> {f[0] == 1, f'[0] == ...


3

If you mean the vertical line, this is created by only one point. p = Plot[N[Im[isinh]], {e, 0, 2}, PlotRange -> Full, Exclusions -> None, WorkingPrecision -> Infinity]; list = Cases[p, Line[x_] :> x, -1]; ListPlot[list, PlotRange -> All] If you delete this point then: point = Cases[p, {x_ /; Abs[x - 1] < 0.01, y_ /; y < 0.5}, ...


1

I wanted to comment a "Thank You" to @dbm for asking and @Daniel Lichtblau for answering, but don't have the necessary reputation yet. There's also a way to bypass this problem in certain cases that wasn't explicitly stated here, so I figured I'd mention it. I ran into this same issue when randomly generating momenta (also for a particle physics problem), ...


2

Not sure if I understand, anyway: intpoints = {{0, 17.9817}, {0.0521424, 18.5701}, {0.105454, 19.1892}, {0.15991, 19.8416}, {0.215494, 20.5299}, {0.272199, 21.2567}, {0.330029, 22.0243}, {0.388993, 22.8348}, {0.449111, 23.6897}, {0.510411, 24.5896}, {0.572931, 25.5338}, {0.636716, 26.5201}, {0.701823, 27.5438}, ...


0

This can be handled by Solve straightforwardly: r = RandomInteger[{-10, 10}, {2, 2}]; a = {{a1, 0}, {0, a2}}; b = {{b1, b2}, {b1, b2}}; c = {{c1, c1}, {c2, c2}}; Solve[r.a + b == c, {a1, a2, b1, b2, c1, c2}] {{a2 -> 18 a1, b2 -> -45 a1 + b1, c1 -> -9 a1 + b1, c2 -> 9 a1 + b1}} You can interpret this as saying that for any a1 and b1, the other ...


1

Clear[t, f, m] pts = Table[t, {t, 0, 500, 10}]; sol = {#, m /. First@NSolve[-(E^(((0.057` m #)/(m + 0.013`)))/(10^5 1.66`)) + m - 10 == 0, m, Reals]} & /@ pts; Grid[Join[{{"t", "solution"}}, sol], Frame -> All]


1

The generic equations to be solved are in the OP's Comments. To answer the second question first, the equations can be written compactly as imax = 26; eqs = Table[n0 n[i + 1] == C[i] n[i], {i, imax - 1}]; var = Table[n[i], {i, imax}]; eqnrm = Sum[n[i], {i, imax}] == 1; eqsum = Sum[i n[i], {i, imax}] - n0 == 0; The first question is answered as follows. ...


2

r = Reduce[Rationalize@-(E^(((0.057` m t)/(m + 0.013`)))/(10^5 1.66`)) + m - 10 == 0] /. C[1] -> 0 // ToRules Then you can either look at the rotated inverse plot: Plot[t /. r, {m, 1, 100}] Or if you want to spend some time, ask Mathematica to compute it: f[m_] := ...


2

There are a very large number of syntax errors. The most serious relate to use of protected symbols: D, I. This is a correction that should work. Please adjust plot range to your needs: sirds[α_, β_, δ_, μ_] := {S[t], SS[t], i[t], R[t], d[t]} /. First@NDSolve[{S'[t] == -α*S[t]*i[t] - δ*SS[t], i'[t] == α*S[t]*i[t] - β*i[t] - μ*i[t], R'[t] ...


1

(* Clear stuff *) ClearAll[c33, c44, c13, c11, s, myvars, vars] (* Assign some values to constants *) c33 = -7; c44 = -1/3; c13 = 13; c11 = 11; (*Solve it *) sols = Solve[Sqrt[c33 c44*s^4 + (c13^2 + 2 c13 c44 - c11 c33)*s^2 + c11 c44] == 0, s]; (* pick out those with non-zero real component *) sols2 = Select[s /. sols, Re[#] != 0 &]; (* make an ...


0

Solve fails, because with so many extra variables there is no unique solution for h. Try solving for more of the variables at once. m == P (L - x) \[Sigma] == (m y)/i y == h/2 i == (b*h^3)/12 Solve[{m == P (L - x), \[Sigma] == (m y)/i, y == h/2, i == (b h^3)/12}, {h, y, m, i}] (* {{h -> -((Sqrt[6]*Sqrt[L*P - P*x])/(Sqrt[b]*Sqrt[\[Sigma]])), y ...


1

FindInstance[ 1/2 == x/(1000000000000 + y)*(x - 1)/(1000000000000 + y - 1) && x > 0 && y > 0, {x, y}, Integers] (*{{x -> 756872327473, y -> 70379110497}}*)


0

I'm not sure I understand your question correctly, but a parallel line could look like and be constructed as follows. The interesting points: p1 = Plot[{f1, f2, f3}, {x, -5, 5}, PlotLegends -> "Expressions", Epilog -> {Red, PointSize[Large], Point[{{1, 0}, {-1, 2}, {-1, -2}, {-3, 0}}]}] And connected with a InfiniteLine infL = ...


1

Solve[{y == 1 - x, y == x - 1}, {x, y}] Solve[{y == 1 - x, y == x + 3}, {x, y}] seems the simplest approach. Another "overkill" region approach: l1 = InfiniteLine[{{0, 1}, {1, 0}}]; l2 = InfiniteLine[{{0, -1}, {1, 0}}]; l3 = InfiniteLine[{{0, 3}, {1, 4}}]; ri1 = RegionIntersection[l1, l2]; ri2 = RegionIntersection[l1, l3]; Reduce[RegionMember[ri1, {x, ...


3

Use Solve the neat way (and see here): Solve[{f1 == f2}, x] {* {x -> 1} *} Solve[{f1 == f3}, x] {* {x -> -1} *} Plot[{f1, f2, f3}, {x, -5, 5}, PlotLegends -> "Expressions", Epilog -> {Red, PointSize[Large], Point[{{1, 0}, {-1, 2}}]}]


3

Here it is an overkill but maybe for general context it is worth to say this. It does not work because fs are not regions: f1 = ImplicitRegion[{y == -x + 1}, {x, y}] f2 = ImplicitRegion[{y == x - 1}, {x, y}] Solve[{k \[Element] f1, k \[Element] f2}, {k}] {{k -> {1, 0}}} I said an overkill because people usually do something like: Solve[{y == -x ...


1

Beware, traveler: Much code ahead! So, let's go: Subscript is not a symbol for Mathematica (well, Subscript is, obviously, but its combination with arguments, i.e. Subscript[...] is not), which leads to surprising behavior sometimes. You can make symbols from such constructs with the Notation package however, if you really require that: ...


1

Just replace the parameter C[1] so that the condition becomes true. For instance sol = {x, y} /. NSolve[x^2 - 5 y^2 == 1, {x, y}, Integers] /. C[1] :> 3 and to extract the coefficients of the sqare-roots Cases[sol[[1, 1]], coeff_*Sqrt[__] :> coeff, Infinity]


1

t = 12; ρ = 8/10; A = 70; SuperStar[t] = (α ρ (t + L) - t)/(α ρ - 1); eq = (1 - α)^2 + (t^2 p)/(((SuperStar[t] - L) (SuperStar[t] - L - 2 t))*A) == 0; soln = Solve[eq && 0 <= α <= 1 && 10 <= p <= 100 && 1 <= L <= 10, α, Reals]; Plot3D[Evaluate[Max[2/10, α] /. soln], {L, 1, 5}, {p, 10, 40}, BoxRatios -> 1, ...


5

Translated that roots() function from Matlab code to Mathematica, about 4 times faster than NRoots . Clear["`*"]; n=2000; m=RandomReal[1,{n,10}]; res1=x/.(ToRules@NRoots[FromDigits[#,x]==0.,x]& /@ m);//AbsoluteTiming (*-------------------------------*) roots[c_List]:=Block[{a}, a=DiagonalMatrix[ConstantArray[1.,Length@c-2],-1]; a[[1]]=-Rest@c/First@c; ...


0

Piecewise seems to accomplish what you want. I don't think WhenEvent can be used, but I'm not completely sure. k[x_] := Piecewise[{{2, x < 5}, {-1, x > 5}}]; {sol} = NDSolve[ {D[u[t, x], t] == k[x] + D[u[t, x], x, x], u[0, x] == 0, u[t, 0] == Sin[t]}, {u}, {t, 0, 10}, {x, 0, 10}, Method -> {"MethodOfLines", ...


2

t = 12; r = 2; nrs = 40; f[x_] := (x*r*(t + l) - t)/((x*r) - 1) eq = (1 - x)^2 + t^2/((f[x] - l)*(f[x] - l - 2*t))*(p/(nrs)) == 0 Plot3D[x /. Solve[eq, x], {p, 10, 50}, {l, 2, 10}]


3

Why not make use of Mathematica built-in functional capabilities? The following code can be modified to add whatever stopping condition is desired. jac[f_, vars_] := Outer[D, f[Sequence @@ vars], vars] jacobian[f_, vars_, pt_] := jac[f, vars] /. Thread[vars -> pt] newt[f_, vars_, pt_] := pt - Inverse[jacobian[f, vars, pt]].f[Sequence @@ pt] ...


2

ListPlot requires lists of point coordinates, but the code was providing it with lists of lists. This can be fixed by replacing the last two lines by yvar = Transpose[Table[MF[[1, ii]][[2]], {ii, 1, 5}]]; ListPlot[Table[{xvar[[i]], yvar[[j, i]]}, {i, 5}, {j, 8}], PlotStyle -> Black] Is this what you had in mind?


1

The simplest code to create your module is nr[func_, jac_, y1_, y2_, MaxIter_, Tol_] := Module[{y10 = y1, y20 = y2, counter = 0, DeltaY = {0.1, 0.1}, list = Table[{0, 0}, {i, 1, MaxIter}], i = 1}, While[Norm[DeltaY, 2] > Tol, Result = Solve[jac[y10, y20].{{dy1}, {dy2}} == -func[y10, y20], {dy1, dy2}] // N // Flatten; DeltaY = ...


4

Since it's triangle functions, I'll try Fourier transformation: FourierCoefficient[#, x, n] & /@ (A Sin[x] + B Cos[x] == 0) Reduce[ForAll[{n}, %], {A, B}] A == 0 && B == 0



Top 50 recent answers are included