New answers tagged

3

x = FindInstance[{Cot[Sqrt[λ]] == Sqrt[λ], λ >= 0, λ < 100}, λ, 100] You can take the numerical value of the solution using N and use ReplaceAll (/.) to get the values and finally take the square root: λ /. N[x] // Sqrt {0.860334, 3.42562, 6.4373, 9.52933} This should work regardless of the number of solutions.


0

Introduction For many transcendental functions, NSolve can solve for the roots, but not in this case. Since the roots are real we can apply the "Chebyshev-proxy rootfinder" method (CPR) which is based on the "colleague matrix" of a truncated Chebyshev series approximation to the function (see this answer by J.M. and the book by Boyd (2014)). The first ...


11

Some explanations first The substitution in the question introduces the reduced wave function $u(r)$ by solving the original radial equation in polar coordinates, $$-\frac{1}{2}\left(R''(r)+\frac {1}{r}R'(r)\right) - \frac{1}{r}R(r) + \frac {m^2}{2r^2}R(r) = E R(r)$$ using the ansatz $$R(r)\equiv \frac{1}{\sqrt{r}}u(r)$$ The apparently divergent ...


2

List @@ Roots[x^3 - 5 x + 4 == 0, x][[All, -1]] (* {(1/2)*(-1 - Sqrt[17]), (1/2)*(-1 + Sqrt[17]), 1} *) EDIT: To understand a complex expression, decompose it and rebuild it, step-by-step, examining each intermediate step. expr1 = Roots[x^3 - 5 x + 4 == 0, x] (* x == (1/2)*(-1 - Sqrt[17]) || x == (1/2)*(-1 + Sqrt[17]) || x == 1 *) The ...


2

A methode i like to use and a starter. Please see Bisection method and Bisection, in particular: Let $a_n$ and $b_n$ be the endpoints at the nth iteration (with $a_1=a$ and $b_1=b$) and let $r_n$ be the nth approximate solution. Then the number of iterations required to obtain an error smaller than epsilon is found by noting that ...


0

This is a good example of the "dynamic range" problem in Boyd's CPR method (see also this answer by J.M.). As α moves toward -100, the OP's oscillatory Whittaker function decays exponentially. According to Boyd, where $ε_{mach}$ is the machine epsilon and $f_{max}$ is the maximum of $f(x)$ over an interval $[a,b]$, "If a function $f(x)$ has a magnitude as ...


0

Here's a fairly quick way: Clear[M, A, b, c, d, f, in]; With[{s = M /. First@ Solve[A == M/(f d/2 (1 + Sqrt[1 - 3.53 (M/(b d^2 c))])), M] /. f -> 500 // Simplify}, With[{cf = Compile @@ Hold[{{in, _Real, 1}}, Block[{A, d, b, c}, A = in[[1]]; d = in[[2]]; b = in[[3]]; c = in[[4]]; s], RuntimeAttributes -> ...


4

There is no solution to your equation. If you specify Reals for k Mathematica outputs an empty list as solution: NSolve[113.68/k + 1345.6/k^2*(1 - Exp[-k/11.6]) == -4.9, k, Reals] (*{}*) If you plot the righ and left hand side of the equation they don't cut each other: Plot[{113.68/k + 1345.6/k^2*(1 - Exp[-k/11.6]), -4.9}, {k, -60, 60}]


4

The corrected equation can be solved using FindRoot: FindRoot[(113.68 t/k - (1345.6/(k^2))*(1 - Exp[-k*t/11.6]) == -4.9 t^2) /. t -> 1, {k, 0.5}] (* {k -> 0.235142} *) This solves the equation for the value of $k$ corresponding to $t$ = 1 second. FindRoot requires an initial "guess" for the value of $k$; in this case, I've used $k = 0.5$. Other ...


6

Without SetPrecision it actually doesn't work fine in Mathematica 10.4.1: In[2]:= NSolve[eqn, {h, r, fc}] Out[2]= {{h -> 45112.4 + 69798. I, r -> 3.6894*10^11 - 2.09612*10^12 I, fc -> -3.94833*10^7 - 4.35473*10^7 I}, {h -> 0.387583 + 0.0290387 I, r -> 44.9117 - 8.67483 I, fc -> 415.19 + 53.0697 I}} In[3]:= eqn /. % Out[3]= ...


2

Is there any reason you can't solve for logarithms? If you do, NSolve handles the provided example pretty straightforwardly: Thread[y -> (Exp[y] /. NSolve[-y == Log[10^(-50)], y])] (* {y -> 1.*10^50} *)


4

Works fine in Mathematica 10.4.1 NSolve[SetPrecision[eqn, 16], {h, r, fc}] // Chop (* {{h -> 0.3876007531699077 + 0.0289254524823553 I, r -> 44.91373180094011 - 8.66855962462205 I, fc -> 415.1894059341150 + 53.0819264533987 I}} *)


2

Perhaps this, which converted to exact fractions trying to avoid roundoff errors: {ToRules[N[Reduce[Simplify[{vals[[3]]/vals[[1]] == ((112/100)/(1735/10)), vals[[2]]/vals[[1]] == ((29/10*10^-3)/(1735/10))}]]]]} which gives you eight solutions.


3

If all your problems are of this sort, simply use Solve. Solve acts by manipulating the symbols, which in these cases is trivial, so that Solve[1/x == 10^(-50), x] gives the proper answer directly. Mathematica recognizes this equation as $1/x = a$ and solves, yielding $a = 1/x = 10^{(-(-50))} = 10^{50}$. In contrast, NSolve performs a numerical ...


1

In principle you can create an entirely real formulation and use FindMinimum like this: exp = Abs[vals[[3]]/vals[[1]] - 1.12/173.5]^2 + Abs[vals[[2]]/vals[[1]] - 2.9*10^-3/173.5]^2 /. {\[Delta] -> dr + I di , \[Epsilon] -> er + ei I}; sol = FindMinimum[exp , {{dr, -5.7}, {di, 6.1}, {er, -1.4}, {ei, 1.2}}] {1.67033*10^-7, {dr -> ...


1

One possibility would be to restate the problem as a minimization problem, for instance: Minimize[(c - 3)^2 + l^2, {c, l}] returns {0, {c -> 3, l -> 0}}. Another possibility is to use Solve directly: Solve[CoefficientList[Q, x] == 0, {a0, a1, a2}] {{a1 -> 1, a2 -> 0}} This also returns a warning, that Equations may not give solutions for ...


1

p[x_] = a0 + a1*x + a2*x^2; eqn = p[x + 1] - p[x] == 1; If you want only real values, restrict FindInstance to the real domain. FindInstance[ForAll[x, eqn], {a0, a1, a2}, Reals, 10] (* {{a0 -> -(433/10), a1 -> 1, a2 -> 0}, {a0 -> -(207/5), a1 -> 1, a2 -> 0}, {a0 -> -37, a1 -> 1, a2 -> 0}, {a0 -> -26, a1 -> 1, a2 ...


3

If you only care about counting and enumerating, why not use Legendre's three-square theorem? SetAttributes[SumOf3SquaresQ, Listable]; SumOf3SquaresQ[n_] := Mod[n/4^IntegerExponent[n, 4], 8] != 7 FactorialSumOf3SquaresPi[x_] := Total[Boole[SumOf3SquaresQ[Range[x]!]]] FactorialSumOf3SquaresPi[10000] 8746 Or test your conjecture by subtracting $7x/8$ ...


6

Solve provides generic solutions, as stated in the documentation under "Details". This means that when we have symbolic parameters, the solutions may not be valid for all values of those parameters. This must be the case for your equation too. But since your equation has so many parameters, it is very hard to see what is going on. Let us take a simpler ...


1

You probably meant to write f1 = a1 x1 + a2 x2 + a3 x3 == d1; f2 = b1 x1 + b2 x2 + b3 x3 == d2; f3 = c1 x1 + c2 x2 + c3 x3 == d3; With these definitions Solve[f1 && f2 && f3, {x1, x2, x3}]


3

If I carefully avoid any use of division to rearrange a few of your simpler equations and use the results for substitutions thus: sys = {yha Facx + yhb Fbcx == Ic αc, (rcp Cos[θ] Flay+rcp Sin[θ] Flax)-(rcp Cos[θ] Fray+rcp Sin[θ] Frax)==Ia αa, (rcp Cos[θ] Flby+rcp Sin[θ] Flbx)-(rcp Cos[θ] Frby+rcp Sin[θ] Frbx)==Ib αb, Falx + Fblx + fs1l == ml alx, Faly + ...


4

I am not sure I understand the question 100% but here is what I think you are looking for: {vals3DL0, funs3DL0} = NDEigensystem[-(R''[r]/2) - (R'[r]/r) - (R[r]/r), R[r], {r, 0, 200}, 3, Method -> {"Eigensystem" -> {"Arnoldi", "Criteria" -> "RealPart"}, "SpatialDiscretization" -> {"FiniteElement", {"MeshOptions" -> \ ...


10

Brute-force, but compact: DeleteCases[Table[{k, PowersRepresentations[k!, 3, 2]}, {k, 10}], {___, 0, ___}, {3}] {{1, {}}, {2, {}}, {3, {{1, 1, 2}}}, {4, {{2, 2, 4}}}, {5, {{2, 4, 10}}}, {6, {{8, 16, 20}}}, {7, {{4, 20, 68}, {12, 36, 60}, {20, 44, 52}}}, {8, {{8, 16, 200}, {8, 80, 184}, {40, 88, 176}, {72, 120, 144}, {80, 104, 152}}}, {9, {{8, 304, ...


5

You can Try Table[set = {x, y, z} /. NSolve[{n! == x^2 + y^2 + z^2, x > 0, y > 0, z > 0},{x, y, z},Integers]; set = Union[Sort /@ set]; Join[{n}, set], {n, 3,8}] This will give you how you can express a factorial as a sum of three squares. Now you can use further conditions (like $x\neq y \neq z$) with Select or Cases to filter them.


3

You could also do: y /. ToRules@Reduce[{a1 + a2 + a3 + b1 + b2 + b3 + c1 + c2 + c3 == 45, a1 + a2 == 10, b1 + b2 == 3, a3 + b3 == 14, c1 + c2 + c3 == y }, {y}] yields 18 (=c1+c2+c3=y)


2

Try this: eq1 = a1 + a2 + a3 + b1 + b2 + b3 + c1 + c2 + c3 == 45; eq2 = a1 + a2 == 10; eq3 = b1 + b2 == 3; eq4 = a3 + b3 == 14; Then rule = {a1 -> x - a2, b1 -> y - b2, c1 -> z - c2 - c3, a3 -> t - b3}; Then Solve[{eq1 /. rule, eq2 /. rule, eq3 /. rule, eq4 /. rule}, {x, y, z, t}] (* {{x -> 10, y -> 3, z -> 18, t -> 14}} ...


4

Do not despair! eq1 = SetPrecision[298973528525.436 < 10^10*(n - k*3.32192809488736), 50]; eq2 = SetPrecision[10^10*(n - k*3.32192809488736) < 298973528539.862, 50]; sol = FindInstance[eq1 && eq2, {n, k}, Integers] (* {{n -> 1702347304068985, k -> 512457601562468}} *) {eq1, eq2} /. sol (* {{True, True}} *)


2

There are two different methods for solving the OP"s problem : The Method of Lines with the option "SpatialDiscretization" -> {"TensorProductGrid"... The Method of Lines with the option "SpatialDiscretization" -> {"FiniteElement"}. This solution is the Mathematica 10 implementation of the Finite Element Method for transcient PDEs. In both cases ...


6

FindRoot is slowing this down, rather than your function func. UPDATE 1 If every FindRoot evaluation step takes 1 second, and every func evaluation takes 0.02 seconds, then after 20 steps, you will have spent 20.4 seconds. Improving func's performance with 90%, hence it will now take 0,002 seconds, brings down your evaluattion time to 20.04 seconds. ...


4

Solve and Integrate try to solve for the exact value, which takes a lot of time or, in some cases, is impossible. You may want to use NSolve and NIntegrate. λ = 20; μ = 3.1623; f[km_Real] := NIntegrate[Exp[-λ*π*km*r^2*ArcTan[r*Sqrt[μ]]] *2*Gamma[λ*π + 1]/Gamma[λ*π]*r*(1 - r^2)^(-1 + λ*π), {r, 0, Infinity}]; NSolve[f[km]==.5, km] (* {{km -> 5.25146}} *) ...


1

This may help, your problematic jump occurs because you have multiple solutions: With[{t = 1/2, h = 0, eps = 0}, ContourPlot[{ x == 1/2 (1 + Tanh[(x y^2 + eps)/t]), y == Tanh[(x^2 y + h)/t]}, {x, 0, 2}, {y, -1, 1}]]


2

You can use FindInstance to Find several instances: FindInstance[f[x] == 0 && -2.5 Pi < x < 2.5 Pi, x, 4] {{x->-6.28319},{x->-3.14159},{x->-6.28319},{x->3.14159}} or some others: Reduce[f[x] == 0 && -2.5 Pi < x < 2.5 Pi, x] x==-6.28319||x==-3.14159||x==3.14159||x==6.28319 using Length, as suggested by @Michael E2 ...


4

I'll address only the root counting portion. In this paper, Delves and Lyness present a method based on contour integration for counting all the complex roots of a function within a given contour. In your specific case, it goes like this: Round[Chop[NIntegrate[f'[z]/f[z], {z, -5 π/2, -5 π I/2, 5 π/2, 5 π I/2, -5 π/2}]/(2 π I)]] 4 where I used an ...


0

I think it is actually possible to do this purely with plotting function. We can abuse MeshFunctions and ContourPlot3D to do it. f1[x1_, x2_, e_] := x1^2 + x2^2 - e f2[x1_, x2_, e_] := x1 - x2 - e ContourPlot3D[f1[x1, x2, e] == 0, {x1, -3, 3}, {x2, -3, 3}, {e, 0, 3}, MeshFunctions -> {Function[{x1, x2, e}, f2[x1, x2, e]]}, Mesh -> {{0}}, ...


3

This achieves the same as the answer from Ymareth, but uses a different way: With[{f = (#2 /. Solve[25 == #1^2 + #2^2, #2])}, f & /@ Range[1, 10, 1]] It first runs Solve and then inserts the result as the function body to be used in the Map. I'd say it's a matter of taste which to use.


4

Possibly this can be made more elegant but forcing Evaluation and applying Function can achieve what you want I think along these lines... Function@Evaluate[(#2 /. Solve[25 == #1^2 + #2^2, #2])] /@ Range[1, 10, 1]


4

From the FindRoot documentation: FindRoot[lhs == rhs, {x, x0, x1}] searches for a solution using $x_0$ and $x_1$ as the first two values of $x$, avoiding the use of derivatives. ... If you specify two starting values, FindRoot uses a variant of the secant method. Indeed, that does the job pretty much instantly: FindRoot[func[u] - num == 0, {u, -3, 3}] ...


4

An alternative to bill's plotting approach would be to only evaluate the pairing function at the members of the Farey sequence (similar to the approach in this answer). Thus, q2N0[q_Rational] := (Numerator[q] + Denominator[q] + 1) (Numerator[q] + Denominator[q])/2 + Denominator[q] ListPlot[{#, q2N0[#]} & /@ FareySequence[500], ...


0

G[x_] = (Abs[B*(E^-x^2) (x^3)])^2; The definite integral is int = Assuming[{B > 0}, Integrate[G[x], {x, -Infinity, Infinity}]] (* (15/64)*B^2*Sqrt[Pi/2] *) Solving for the exact positive value of B for which the integral is unity soln = Solve[{int == 1, B > 0}, B][[1]] (* {B -> (8*(2/Pi)^(1/4))/Sqrt[15]} *) Verifying that this value of ...


1

You can use Solve, NSolve, Reduce, or FindRoot. Plot[{x^Log[x] - x^Log[2/x], 1, x^Log[x] - x^Log[2/x] == 1}, {x, 0, 3}, PlotLegends -> "Expressions"] NSolve[{x^Log[x] - x^Log[2/x] == 1, x > 0}, x] (* {{x -> 0.543178}, {x -> 2.23791}} *) FindRoot[x^Log[x] - x^Log[2/x] == 1, {x, #}] & /@ {.5, 2.2} (* {{x -> 0.543178}, {x -> ...


1

Plot[{1, x^Log[x] - x^Log[2/x], 1 == x^Log[x] - x^Log[2/x]}, {x, 0, 4}] sol = NSolve[1 == x^Log[x] - x^Log[2/x], x, Reals] first = x /. sol[[1]] second = x /. sol[[2]] Plot[{1, x^Log[x] - x^Log[2/x], 1 == x^Log[x] - x^Log[2/x]}, {x, 0, 4}, Epilog -> {Red, PointSize[Large], Point@{{first, 0}, {second, 0}}}]


1

Here is an adaptation of my solution to Extracting the function from InterpolatingFunction object, which converts an InterpolatingFunction to a Piecewise polynomial interpolation. pwf = Piecewise[ Map[{InterpolatingPolynomial[#1, x], x < #[[3, 1]]} &, Most[#]], InterpolatingPolynomial[Last@#1, x]] &@Partition[data, 4, 1]; {x1, x2} = ...


1

Doesn't change much in this particular instance, but you can use Refine to incorporate assumptions on the parameters in your equations. Keep in mind that expressions in inequality assumptions are assumed to be real. eqns = Refine[{1 == -x + y + z, 0 == y (-4 a/(b - Sqrt[b^2 + 8 a^2])) + z (-4 a/(b + Sqrt[b^2 + 8 a^2])), 0 == x ...


3

You can use LinearSolve. The matrix: mat = {{-1, 1, 1}, {0, -4 a/(b - Sqrt[b^2 + 8 a^2]), -4 a/(b + Sqrt[b^2 + 8 a^2])}, {1, 1, 1} }; The vector: v = {1, 0, 0}; Solving: LinearSolve[mat, v] yields: {-(1/2), (-b + Sqrt[8 a^2 + b^2])/(4 Sqrt[8 a^2 + b^2]), ( b + Sqrt[8 a^2 + b^2])/(4 Sqrt[8 a^2 + b^2])} You could use Solve for the system ...


1

NDEigensystem was added in version 10.2 (or was it 10.3?) but version 10.0 is not going to work unless you use this.


1

Do not use subscripts as variables, these are a display option. Also, don't start variables and function with capitol letters. This works fine: t[x_] := c0 + c1 x + c2 x^2; Solve[tw == t[xw] && tp == t[xp] && te == t[xe], {c0, c1, c2}]


0

Alternatively, plotting for each solution: Sol = Solve[x^2 == 1, x]; Plot[Evaluate[z*10*t /. z -> Flatten@Sol[[;; , ;; , 2]]], {t, 0, 10}]


0

Try sol = Solve[x^2 == 1, x]; With[{z = sol[[1, 1, 2]]}, Plot[z*10*t, {t, 0, 10}]]


1

I presume you wish to find the first time that P[t] reaches L3. This is given by FindRoot[P[t][[3]] == L3, {t, 6}] (* {t -> 6.2361} *) Addendum It is helpful to plot the curve (here as far as t == 35) along with points at integer values of t. Show[ParametricPlot3D[P[t], {t, 0, 35}, PlotRange -> {{0, L}, {0, L2}, {0, L3}}], ...


3

Solve seems unable to solve your system symbolically. One can solve it numerically for various values of $t$, $\epsilon_1$ and $\epsilon_2$. Setting eps1 = 0 as you indicated, we can use the following: eps1 = 0; Table[ {t, x} /. FindRoot[ { x == 1/2 (1 + Tanh[1/2 (x y^2 - eps1)/t]), y == Tanh[(x^2 y + eps2)/t] }, {x, 1}, {y, 1} ...



Top 50 recent answers are included