New answers tagged equation-solving
2
Maybe you can do something like this:
nielsensFunction[x_?InexactNumberQ] :=
\[FormalY] /. First @ FindRoot[\[FormalY] - Tanh[2 (2 \[FormalY] + x)/5],
{\[FormalY], Tanh[x]}, WorkingPrecision -> Precision[x]]
I used a formal symbol as a temporary variable within FindRoot[] for safety, since they are guaranteed to ...
1
f[x_] := y /. FindRoot[y == Tanh[(2 y + x)/2.5], {y, 0}]
Plot[2.5 Log[2 Cosh[(2 f[x] + x)/2.5]], {x, -1.5, 1.5}]
0
As suggested by b.gatessucks, though this seems to produce imperfect results---and I don't understand why Intersection[out,out] does not remove repeated roots...
eq2 = FullSimplify[eq == 0];
out = ParallelTable[\[Zeta] /.
Quiet@FindRoot[eq2, {\[Zeta], 500 RandomComplex[]}], {5000}];
test = Intersection[out, out];
tol = 10^-1;
list = {test[[1]]};
Do[
...
2
Given the discussion, another approach you might want to consider would be to explicitly parameterize a function -- -- this way you get to control very precisely the form of the function and you can choose it to have a nice shape. As an added bonus, you can perhaps even find an analytical inverse, which greatly simplifies that part of the problem. For ...
2
If you absolutely must use B-splines, you can explicitly build the component functions that make up the B-spline, using the usual definitions:
pts = {{0, 0}, {0.2, 0.7}, {1, 1}};
n = Min[Length[pts] - 1, 3]; (* B-spline degree *)
m = Length[pts];
(* clamped uniform knots for B-spline *)
knots = {ConstantArray[0, n + 1], Range[m - n - 1]/(m - n),
...
3
Inverse of your function sampled and interpolated:
g = InverseFunction@Interpolation[f /@ Range[0, 1, .1]]
(* gives x for y = .6 *)
g[.6]
0.35
Using FindRoot:
FindRoot[second[f[t]] == .6, {t, .5}]
{t -> 0.5}
f[.5]
{0.35, 0.6}
Delaying evaluation:
second[r_?(VectorQ[#, NumericQ] &)] := r[[2]]
More general delay:
...
2
solution = With[{n = 10, r := RandomReal[{-1, 1}]},
Table[{x -> r, y -> r, z -> r, w -> r}, {n}]];
Select[solution,
With[{u = Apply[ArcTan, {x, y} /. #]}, -.5 Pi < u < 0] &]
Or:
Cases[solution, {x -> a_ /; a > 0, y -> b_ /; b < 0, __}]
9
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 ...
0
This is not a final solution, but I hope it is an useful approach:
First, define a function which depends on your variable x (for me x is a real number) and your parameters a,b,c,d,e,f (integers between -10 and 10):
k[x_,a_,b_,c_,d_,e_,f_]:=(a*x+b)^(1/3)+(c*x+d)^(1/3)+(e*x+f)^(1/3)
You could use a graphical solution. E.g. use
...
0
I presume what you have written, is an algebraic identity. Otherwise it just doesn't make sense to me.
That being the case, I can show that either k or {a,c,e} must be 0.
Since $$\sqrt[3]{a x + b} + \sqrt[3]{c x + d} + \sqrt[3]{e x + f} = k$$ is an identity, it should be valid for all values of x, including $$ x = 0 $$ which will give: $$ \sqrt[3]{b} + ...
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 ...
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 ...
12
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 ...
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
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
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 ...
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 ...
1
The following is also useful:
f11[l_] := Root[54 + 9 Sqrt[6] l + (-108 - 15 Sqrt[6] l) #1 + (72 + 7 Sqrt[6] l) #1^2
+ (-20 - Sqrt[6] l) #1^3 + 2 #1^4 &, 1]
f12[l_] := Root[54 + 9 Sqrt[6] l + (-108 - 15 Sqrt[6] l) #1 + (72 + 7 Sqrt[6] l) #1^2
+ (-20 - Sqrt[6] l) #1^3 + 2 #1^4 &, 2]
f13[l_] := Root[54 + 9 Sqrt[6] l ...
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 ...
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 + ...
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 ...
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, ...
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, ...
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 ...
1
Following the comment of J.M., it's possible to use CountRoots[], for the case in the question one possible solution is
myF[Q_, mu2_, mu4_] := -3 + 3 mu2 q^2 + 4 mu4 q^4 - 6 mu2 q Q - 8 mu4 q^3 Q + 3 mu2 Q^2 + 4 mu4 q^2 Q^2
myCR[Q_, mu2_, mu4_] := CountRoots[myF[Q, mu2, mu4], {q, 0, Q}]
ContourPlot[myCR[myQ, mu2, mu4], {mu4, 0, 15}, {mu2, 0, 2},
...
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 ...
1
This question could be easily answered by reading the documentation...
Solve[
{-c + (1/(b - a)) (2 p q - p a + p (q - a) + p (u - r p + g j) +
s (u - r p + g j) + s (b - q) + s b - 2 s q) == 0,
(1/(b - a)) (q (q - a) + ((q - a)^2)/2 + (u - g j) (q - a) -
2 r p (q - a) + s r (b - q)) == 0,
-1 + (1/(b - a)) (p (q - a) g - s g (b - q)) == 0},
{p, q, j}]
1
If you specify some integer value for g and r then you get the solution for your
system
LE[g_, r_] := Module[{eqs},
eqs = {q*(q - a) + u*(-r + 1) (p^r) (j^g)*(b - q) +
r*s*u*(p^(-r - 1)) (j^g) (b - q) == 0,
p*(2*q - a) - u*(p^(-r - 1)) (j^g) + (b - q) (s - b) +
s*u*(p^(-r)) (j^g) - s (b - 2*q) - c*(b - a) == 0,
u*(p^(-r)) g (j^(g - 1))*(b - q) ...
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 ...
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}}*)
3
Make it a purely numeric function so that FindRoot cannot do anything fancy with the symbolic form. This can be done as below.
ff[k_?NumberQ] := Nest[# (1 - #) k &, 1/2, 2^4]
FindRoot[ff[k] == 1/2, {k, 3.5}]
(* Out[22]= {k -> 3.49856169933}` *)
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, ...
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 ...
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]}, ...
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 ...
8
If you make any assumptions you have to share them with Mathematica as well.
For Example:
Assuming[R > 0, FullSimplify[(R^3)^(1/3)]]
(*R*)
The default assumption is that all variables are complex. (As @J.M. noted in the comments).
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 *)
Top 50 recent answers are included
