Hot answers tagged equation-solving
11
It took me quite a while, but finally, here's a visualization of the perigee of Flamsteed's comet:
I should first note two things: first, some of the needed data for computing the orbit of comet C/1683 O1 was missing in AstronomicalData["CometC1683O1", "Properties"], and I had to pull information from external sources to supplement the information ...
9
First, one should mathematically analyze the problem. Obviously there are infinitely many solutions of the form {1, y} and {x, 1}, as well as {x,y} where x == y. So we can exclude such solutions from our search.
Another point is remembering SystemOptions["ReduceOptions"]. There were questions dealing with them, so I'm not going to discuss these issues here; ...
8
I upvoted the response by @J.M. and was tempted to leave it at that. This is similar but automates the process a bit further by explicitly implicitizing (is that an oxymoron?) the tori. Somehow I think that step deserves mention since it can be a useful thing in its own right.
We start with code to take the trig parametrized tori and find algebraic implicit ...
7
You should use the SolveAlways function, which will solve your equation for all values of the parameters (in this case for any t). So the solution to your question is
SolveAlways[4 b*Cos[2 t] - 4 a*Sin[2 t] == 4 Cos[2 t] + 8 Sin[2 t], t]
or rather
SolveAlways[4 b*Cos[2 t] - 4 a*Sin[2 t] == 4 Cos[2 t] + 8 Sin[2 t], {Sin[2 t], Cos[2 t]}]
(* => {{a ...
7
The incomplete Euler gamma function is defined with :
$$\Gamma(a,z)=\int_{z}^{\infty} t^{a-1} e^{-t} d t$$
You can observe that the integral is defined for Re[a] > 0 :
Integrate[t^(a - 1) Exp[-t], {t, 0, Infinity}]
ConditionalExpression[ Gamma[a], Re[a] > 0]
while for a == 0 this does not converge.
Starting with your recurrence relation one ...
7
If you're happy with an approximate solution, you can use NSolve[]. As I mentioned in an answer to an earlier question of yours, GroebnerBasis[] can be used for parameter elimination. Let's do that for your three "tori":
t1 = First @ GroebnerBasis[Thread[{x, y, z} == Rationalize[torus1[a, b]]] ~Join~
{Cos[a]^2 + Sin[a]^2 == 1, ...
6
Since all the functions are roots of the same polynomial, a recommended approach uses a definition of one function instead of defining them separately. Thus I'd rather proceed along this way:
f[x_, k_Integer] /; 1 <= k <= 4 :=
Root[ 54 + 9 Sqrt[6] x + (-108 - 15 Sqrt[6] x) #1 + (72 + 7 Sqrt[6] x) #1^2
+ (-20 - Sqrt[6] x) #1^3 + 2 #1^4 ...
6
Here's a higher calculus way: maximize the curvature.
eqn = 9 + 22 x + 9 x^2 + 46 y + 24 x y + 16 y^2;
grad = D[eqn, {{x, y}}];
hessian = D[grad, {{x, y}}];
curvature = Cross[grad].hessian.Cross[grad]/(#.# &@grad)^(3/2) // Simplify
(* 5/(26 + 9 x^2 + 40 y + 16 y^2 + 6 x (5 + 4 y))^(3/2) *)
Maximize[{curvature, eqn == 0}, {x, y}]
(* {5, {x -> ...
5
It's just not always true that $(R^3)^{1/3} = R$. How about $R=i$, for example?
N[(I^3)^(1/3)]
(* Out: 0.866025 - 0.5 I *)
If you expect this, you might have more luck with the real-valued CubeRoot function. For example:
FullSimplify[CubeRoot[R^3]]
(* Out: R *)
5
Solve[] works much better with exact arithmetic:
AdjustPar20[x_] := a x^b Exp[c x]
p = 937126/100000;
sol = Solve[
AdjustPar20[5/100] == p &&
((D[AdjustPar20[t], t] == 0) /. t -> 5/100) &&
AdjustPar20[0] == 0, {a, b, c}, Reals]
ParametricPlot3D[{a, b, c} /. sol, {a, p, 10 p},
PlotRange ...
5
No errors if you work with exact arithmetic instead:
NSolve[Rationalize[
T == (0.000250709 E^(0.0269867/(0.0000734429 + 1. T)))/
(1.00025 - 1. E^(0.0539734/(0.0000734429 + 1. T))), 10^-10], {T}, Reals]
(*{{T -> -6.55871*10^-164}, {T -> 216.923}}*)
5
Use inequalities, as Reduce knows how to work with those.
Reduce[0 <= y^2 <= 4, y, Reals]
(* Out[9]= -2 <= y <= 2`*)
Interval[] resides mostly in the arithmetic/numerical world, and symbolic solving with those will at best, in general, give an overestimated result (that is, one that properly contains the actual result). Here is an example. We ...
5
For nonlinear systems of equations and inequalities FindInstance uses the cylindrical algebraic decomposition (CAD) algorithm. The algorithm may use equational constraints to simplify the computations by "eliminating" variables. Hence replacing equations with inequalities can make the problem harder.
Another problem in this example is that EuclideanDistance ...
5
I tried your example in version 8 and had no problems solving it. To save typing, I shortened it as follows:
With[{n = 6},
Solve[
And @@ Table[
Sum[(Subscript[y,
k] - (a Subscript[x, k]^3 + b Subscript[x, k]^2 +
c Subscript[x, k] + d)) (-Subscript[x, k]^j), {k, 1, n}] ==
0, {j, 0, 3}],
{a, b, c, d}
]
]
Then I ...
5
If you are looking for exact solutions you should substitute machine precission numbers by exact numbers. Therefore instead of your numerical coefficient I'd rather use this one:
(7/5) (30^5) 2^(9/2) 9 (3/5) (14/4) (1 + Log[3])
N[%]
10287648000 Sqrt[2] (1 + Log[3])
3.05326*10^10
This is a huge number so for the sake of simplicity instead of playing ...
4
CountRoots is an appropriate function. It may work also with more general functions than polynomials. Two or more-variable polynomials may have infinitely many roots in a compact region, e.g. this one: $\;p(x,y,z)=x^2+y^2+z^2-1 \quad$ has infinitely many roots (continuum) on the unit sphere. In such cases CountRoots cannot give an adequate answer since it ...
4
Here's a short routine for computing the Mach number from the Prandtl-Meyer equation:
prandtlMeyerMachNumber[γ_?InexactNumberQ, ν_?InexactNumberQ] :=
Module[{prec = Precision[{γ, ν}], β, η, λ, m},
λ = Sqrt[SetPrecision[(γ - 1)/(γ + 1), ∞]];
η = ν + π (1 - 1/λ)/2;
m = ((3 + γ) η^2/12 + 2/(1 - γ))/η;
Sqrt[β^2 + ...
4
Making it a non-linear equation works :)
Reduce[(x + y + z - 1)^2 == 0, {x, y, z}, Modulus -> 7]
$$
(x=0\land y=0\land z=1)\lor (x=0\land y=1\land z=0)\lor (x=0\land y=2\land
z=6)\lor (x=0\land y=3\land z=5)\lor (x=0\land y=4\land z=4)\lor
(x=0\land y=5\land z=3)\lor (x=0\land y=6\land z=2)\lor (x=1\land
y=0\land z=0)\lor (x=1\land y=1\land ...
3
You might use rule replacement (instead of variable assignment) to inject specific values for the parameters.
ee = C1 - 10 + PG/2 + GC1 + GL1 == 0 &&
C2 - 15 + PG/2 + GC2 + GL2 == 0 && GL1 - fd (a1) t 10 == 0 &&
GL2 - fd (a2) t 15 == 0 &&
GC1 - (t (1 - fd) 25 - PG) ((p1)/((p1) + (p2))) == 0 &&
GC2 - (t ...
3
This isn't really an answer, but it's too big for a comment.
Here's some code to brute force solve the problem (since there wasn't any code provided in the question). It lists all the possible numbers; finds the ones whose product matches; then of those, finds the ones whose sum of squares match, etc..
Module[{h = 50, r, product, squared, fourth, sixth},
...
2
Your sequence is
q[0] = 0
q[i_] := 1 + (i - 1)*q [i - 1]
And I used the following code to find some terms for the above sequence.
For[k = 1, k < 12, k++, Print[ q [ k ] ] ].
And the output is
1, 2, 5, 16, 65, 326, 1957, 13700, 109601, 986410, 9864101
These numbers are "Total number of arrangements of a set with n elements". You can find them here.
2
Here's another way expand the solutions to a linear equation:
Evaluate@Reduce[x + y + z == 1, {x, y, z}, Modulus -> 7,
GeneratedParameters -> Slot] & @@@ Tuples[Range[0, 6], 2]
(* {x == 1 && y == 0 && z == 0, x == 7 && y == 1 && z == 0, ...,
x == 73 && y == 6 && z == 6} *)
There are ...
2
We start with the given differential polynomials.
a1 = A1*D[p1[x, y, z], {z, 2}] -
A2*(D[p1[x, y, z], {x, 2}] + D[p1[x, y, z], {y, 2}] +
D[q1[x, y, z], {x, 1}] + D[q2[x, y, z], {y, 1}]);
a2 = A9*(A2*
D[(D[q1[x, y, z], {x, 1}] + D[q2[x, y, z], {y, 1}]), {x, 1}] +
A2*(D[q1[x, y, z], {x, 2}] + D[q1[x, y, z], {y, 2}])) -
A4*(D[p1[x, ...
2
Easiest perhaps is to find them all and cull out the one you want. One way is as below. Since it is even in y I substitute y->Sqrt[y] to cut the degree in half and compensate in the result.
minroot[g_?NumericQ, b_?NumericQ] := Module[{rts, y},
rts = y /. Solve[g^2 - b^2*g^2*y - 4 y^6 + 4 y^3 == 0, y];
rts = Select[rts,
With[{nval = N[#, 100]}, ...
2
For very simple examples like your example you could use something like this:
GetValues[known_] := With[known, {a, b, c} /. First[Solve[a*b == c]]]
This works due to the undocumented (?) feature that Solve will work without a second argument and if only one unkown is left it seems to always be doing "the expected thing", e.g.:
Solve[23*x+5==6]
I'd be ...
2
I am not certain I understand, but starting with sols = Solve[ . . . ] does this help?:
{{x1, y1}, {x2, y2}, {x3, y3}} /. sols;
Union[Sort /@ %]
{{{-17, 7}, {7, -17}, {13, 13}},
{{-11, 3}, {7, -9}, {7, 9}},
{{-9, -3}, {3, 9}, {9, -3}},
{{-9, 7}, {3, -11}, {9, 7}},
{{-5, -5}, {1, 7}, {7, 1}},
{{-3, -9}, {-3, 9}, {9, 3}},
{{-3, 3}, {3, -3}, {3, 3}}}
...
2
You can minimize the distances between 3 points that each belong to a torus :
res = NMinimize[
Norm[torus1[x1 , y1] - torus2[x2 , y2]]
+ Norm[torus3[x3 , y3] - torus2[x2 , y2]],
{x1, y1, x2, y2, x3, y3}]
(* torus1[x1 , y1] /. res[[2]] --> {10.5868, -2.73435, -2.34231}
torus2[x2 , y2] /. res[[2]] --> {10.5868, -2.73435, ...
2
I would leave this as a comment if I could...
You can solve these analytically using some complex analysis and trigonometry as per this link.
Also Tristan Needham's excellent Visual Complex Analysis deals with solving cubics in depth. I know its not Mathematica *per se*, but should be usable along side of it. The trigonometric solution might be a little ...
2
One way to find the parameters {a,b,c} is the following:
f[x_]=(660 (-0.37 + b) (x - c))/(660 + a) - 0.37 c
sol = FindFit[data, f[x], {a, b, c}, x]
Where data is a List[] of {x,y} pairs that you want to use to fit the parameters. The problem isn't very well posed however: f[x] describes a straight line with three parameters instead of the two that would ...
2
There are other solutions, this is correct. ContourPlot gives an idea:
ContourPlot[{
-.5 Tan[.5 Pi x] + y == 0,
-.5 Tan[.5 Pi y] + x == 0}, {x, -5.5, 5.5}, {y, -5.5, 5.5},
PlotPoints -> 20,
Frame -> False, Axes -> True,
Exclusions -> Join[
Table[{x == i}, {i, -5, 5, 2}],
Table[{y == i}, {i, -5, 5, 2}]]]
Exclusions prevents ...
Only top voted, non community-wiki answers of a minimum length are eligible
