New answers tagged equation-solving
1
sol = Solve[(1/8) (-A1 + x2 + \[Alpha] + x1 (-2 + \[Beta]) - 2 \[Beta] x2^2 - \[Theta] x1^2) == 0 &&
(1/16) (A1 + 3 x2 - \[Alpha] - 2 \[Beta] x2 + x1 (-2 + 3 \[Beta]))^2 - \[Theta] x2^2 == 0, {x1, x2}];
Dimensions[sol]
{4, 2}
So you have 4 sets of solutions each with 2 variables. Is that unexpected?
The standard format of solution ...
2
We have to be a little careful here. Since the equations are quadratic in x and cubic in y, Solve will return six solution pairs for x and y. But not all the solutions will produce real-valued functions over the parameter AA, In fact, there are only two unique solutions for x. For y there are six different solutions, but two them are only real-valued at AA = ...
3
sol = Values@Solve[{x^2 - 5 x + 6 AA == 0, y^3 - AA x^2 == 0}, {x, y}] //
Flatten // DeleteDuplicates
Plot[sol, {AA, -6, 2}, PlotLegends -> "Expressions"]
2
First you can define your functions as
(*here i ranges from 1 to 6*)
xsol[i_][t_]:=Part[(x/.Solve[{x^2-5x+6 AA == 0, y^3 -AA x^2 ==0}])/.AA->t, i]
ysol[i_][t_]:=Part[(x/.Solve[{x^2-5x+6 AA == 0, y^3 - AA x^2 ==0},{x,y}])/.AA->t, i]
Plot[Evaluate[Table[xsol[i][t], {i,1,6}]],{t,-2,2}]
Plot[Evaluate[Table[ysol[i][t],{i,1,6}]],{t,-2,2}]
4
Here is one approach:
sol = Solve[{x^2 - 5 x + 6 AA == 0, y^3 - AA x^2 == 0}, {x, y}];
Plot[Evaluate[{x, y} /. sol], {AA, 0, 25/24}]
4
The AsymptoticSolve command works with the result of the Solve command. Let us consider these results.
Solve[(a*Sin[y]^2 + Sin[x])^2 == x, y]
results in 8 expressions of the form y->ConditionalExpression which are infinitely valued because of terms 2 \[Pi] C[1], C[1] \[Element] Integers . I think this circumstance makes difficulties. The following works ...
6
Use Solve instead of Reduce, with an extra constraint as given by @Artes:
Solve[x^2*(1 + x) == y*(-1 + 3*y) && -10^3 <= x <= 10^3, {x, y}, Integers]
(* {{x -> -1, y -> 0}, {x -> 0, y -> 0}, {x -> 1, y -> 1},
{x -> 4, y -> -5}, {x -> 6, y -> -9}} *)
4
Assuming[σ > 0 && 0 < p < 1/(σ*Sqrt[2π]),
Solve[PDF[NormalDistribution[μ, σ], x] == p, x, Reals] // FullSimplify]
(* {{x -> μ - σ*Sqrt[-Log[2π] - 2*Log[p*σ]]},
{x -> μ + σ*Sqrt[-Log[2π] - 2*Log[p*σ]]}} *)
11
Regarding the title of the question, is the result of Reduce really odd? Reduce simply reduces systems of equations, inequalities, domain specifications, logical expressions etc. And so it is not too odd.
Quite frequently we get similar expressions in the output. A natural suggestion is to reformulate the input since there are two variables $x$ and $y$ ...
5
It seems to me that fa[a] behaves relatively well with respect to FindRoot and plotting but not simplification. That a computation, whether or not it is FindInstance[], might exhaust system resources is unremarkable, but it's likely that an exact-symbolic computation with floating-point numbers will be worse. On things that would cancel or equal each other, ...
5
I think that mixing of huge numbers and machine precision is what's making Mathematica go crazy (so this is not a bug, but a lack of feature). In general, running functions best suited for analytic expression transformations like FullSimplify and FindInstance on expressions with floating point numbers is a bad idea except in simple, well-understood cases.
...
5
Just use Solve instead of Reduce. We can eliminate $p$ by setting
f[x_] = Abs[a x + b] + Abs[c x + d] + m x^2 + n x;
and looking for $f(1)=f(2)=f(3)=f(4)=f(7)=f(9)=-p$ (which is necessarily integer when all parameters are integers).
As suggested by @Akku14, enlarging the search space yields solutions for $m\neq 0$:
Solve[Join[{Equal @@ f /@ {1, 2, 3, 4, 7,...
0
There is plenty of room for performance optimization in this. Have a try on the thread:
Performance tuning in mathematica
Better look deep into Mathematica on Stackexchange to avoid double questions.
4
If I understand your computations, this can be done with Fold:
Fold[RollLM[dz, 210000, 262440000 π, pBF[(#2 - 0.5) dz]].#1 &, Vec2A, Range[n]] // Simplify;
This gives the same result as your Do[...] // Last // Simplify. Next let's compute Vec3A and solve:
Vec3A = BearLM[810000, 850000].% // Simplify
Solve[{%[[3]] == 0, %[[4]] == 0}, {vA, PhiA}][[1]]
...
4
This uses less memory:
Last@Reap@Do[
With[{n = Sqrt[1 + 12 x^2 (1 + x) + 0``1]}, (* <-- N.B. *)
If[FractionalPart@n == 0, Sow@{x, Round[n]}]] &,
{x, 10^(10)}]
On my machine the first and last 10^6 iterations take about 0.4 seconds, so I project it might finish in less than an hour and a half.
2
In this sort of problem in which $y=h(x)$ is defined implicitly by $g(x,y)=0$, we can compute its derivative $h'(x)$ in terms of $g(x,h(x))$:
fy /: fy' = (fy'[#] /. First@Solve[D[dy[#, fy[#]] == 0, #], fy'[#]] //
Evaluate) &;
Here $h$ is fy and $g$ is dy. Now FindRoot can calculate the derivative (Jacobian) of dxnoy.
ClearAll[f, fy, dx, dy, ...
6
Since this can be readily solved analytically using seperation of variables, another option is to use the analytical solution, and replace the paramaters in the solution without the need to solve it each time.
Mathematica can't solve this analytically, but the analytical solution is
$$
u \left( x,t \right) =\sum _{n=1}^{\infty }-4\,{\frac {\sin \left( nx
...
8
Look carefully at the documentation for NDSolve and Manipulate and see if you can understand how every character of this is working. You can even click on the orange Details and Options for each of those to get additional information. And then
Manipulate[
sol=u/.NDSolve[{D[u[t,x],t]==α D[u[t,x],{x,2}]+a u[t,x],
u[t,0]==0,u[t,Pi]==0,u[0,x]==x(Pi-x)},u,{...
0
You can always brute force it.
eq = x y + y^2 - 1 + (z + Cos[z]) y x - 24*(z + Cos[z]) + Tan[x] == x^4
(Solve[eq /. {z + Cos[z] -> f[z]}, f[z]][[1, 1]] /. Rule -> Equal) /. f[z] -> z + Cos[z]
(*z + Cos[z] == (x^4 - Tan[x] - x y - y^2 + 1)/(x y - 24)*)
This, of course, requires that all expressions containing z be the same form.
2
This function brings everything to one side (f), takes a derivative with respect of variable of interest var and integrates back to get an expression dependent on this variable. This is then the left hand side lhs, the right hand side rhs is formed by the rest of the expression:
Clear[e,iso]
iso[eq_,var_]:=Module[{f,lhs,rhs,g},
f=eq/.Equal[a_,b_]->a-b;
...
4
It doesn't look like AppendTo has much overhead in this case.
n = 20;
dz = 1000/n;
RollLM[l_, EM_, Ixx_, p_] := {{1, l, Power[l, 2] / (2 EM Ixx), Power[l, 3] / (6 EM Ixx), p Power[l, 4] / (24 EM Ixx)}, {0, 1, l / (EM Ixx), Power[l, 2] / (2 EM Ixx), p Power[l, 3] / (6 EM Ixx)}, {0, 0, 1, l , p Power[l, 2] / 2}, {0, 0, 0, 1, p l}, {0, 0, 0, 0, 1}};
BearLM[d_, ...
1
You can launch as many subkernels as you want (and as your license allows) using LaunchKernels. Mathematica launches as many as the number of CPU cores by default, but you can specify the exact number you want, and you can launch more.
Using more subkernels than the number of CPU cores you have will typically lead to no performance improvement at all. ...
4
You can replace the AppendTo loop with
u = Vec2A;
VecAList = Table[
u = RollLM[dz, 210000, 262440000 Pi, pBF[(i - 0.5) dz]].u,
{i, 1, n}];
However, this does not speed up anything as the computations are performed symbolically and this LeafCount[VecAList[[i]] grows exponentially with i (and thus LeafCount[VecAList] grows exponentially with n).
2
If P[4] is a parameter here is a solution.
ClearAll["Global`*"]
LL = 134;
c = {110/493, 150/831, 200/900};
Y = {262, 168, 164};
w = {24/493, 49/831, 61/900};
a = {{0.118, 0.090, 0.109}, {0.249, 0.412, 0.220}, {0.361, 0.259,
0.381}};
{varX, varP} = {Array[X, 3], Array[P, 3]};
var = Flatten@{varX, varP};
lag = -c.varX + varP.(varX - a.varX - Y) + P[4] (...
1
With Reduce you can actually solve this problem; you need, though, to specify the variable you want to use to solve it for:
Reduce[xy + y^2 - 1 + zyx - 24*z + Tan[x] == x^4, z]
which yields as a solution
z == 1/24 (-1 - x^4 + xy + y^2 + zyx + Tan[x])
This will obviously work only if your variable can be expressed explicitly.
3
Solve the first equation for $M$, and plug that in to the RHS of the second equation. You get an expression that, for positive $ϵ$, bottoms out around 85 (with $ϵ$ near $0.02$. In particular, it never gets anywhere near $6.6612$.
4
You want $10^{13}\leq y\leq 10^{14}$, so obviously $10^{26}\leq y^2\leq 10^{28}$. The range of $x$ for which your expression $10^{26}\leq y^2 = 2213326116 + 94098\ x\ (1 + x) (-31363 + 31366\ x)\leq 10^{28}$ can be easily found:
N@Reduce[10^26 < 2213326116 + 94098 x (1 + x) (-31363 + 31366 x) <= 10^28, x]
323584. < x <= 1.50194*10^6
That's ...
4
Here's a direct search using a fast square test from this answer:
sQ[n_] := FractionalPart@Sqrt[n + 0``1] == 0
Reap[Do[If[sQ[441 + 48*x*(1 + x) (-13 + 16*x)], Sow[x]], {x, 2*10^7}]][[2,1]] //AbsoluteTiming
(* {91.0767, {1}} *)
So in 91 seconds we've checked up to $x\le2\times10^7$, which corresponds to $y\le2478\times10^9$.
Using parallel ...
7
Hmm, I just posted an answer yesterday that overcame just this problem with the undocumented option "SolveDiscreteSolutionBound" that controls a system limit:
With[{ropts = SystemOptions["ReduceOptions"]},
Internal`WithLocalSettings[
SetSystemOptions[
"ReduceOptions" -> "SolveDiscreteSolutionBound" -> (1400*10^9)],
Solve[y^2 == 441 + 48*x*(...
6
[Update: Improved second code.]
There is a system limit on Solve, which you can extend this way:
k = 1000000;
n = Ceiling[k^(3/2)];
With[{ropts = SystemOptions["ReduceOptions"]},
Internal`WithLocalSettings[
SetSystemOptions[
"ReduceOptions" -> "SolveDiscreteSolutionBound" -> n],
Solve[x^3 - y^2 == 307 && -k < x < k &&...
4
I used this code to find one. In every iteration I looked up 200k range.
m = 100000;
Total@Boole[IntegerQ /@ Sqrt[Range[8 m, 10 m]^3 - 307]]
1
And extracted the solution using
Position[IntegerQ /@ Sqrt[Range[8 m, 10 m]^3 - 307], True]
{{139788}}
This implies that
x=139788 - 1 + 8 m=939787
is a solution.
{x,y}={939787,911054064}
Since I ...
5
You can find the integer points with Solve:
With[{s = 10^5},
Solve[n == 9 + 108 x^2 (1 + x) && -s <= n <= s && -s <= x <= s,
{n, x}, Integers]]
(* {{n -> -97191, x -> -10}, {n -> -69975, x -> -9}, {n -> -48375, x -> -8},
{n -> -31743, x -> -7}, {n -> -19431, x -> -6}, {n -> -...
3
You see a number of integral points by inspection: e.g. {1,15},{1,-15},{0,3},{0,-3},{-1,3},{-1,-3}.
You can pick a "generator point" and scalar multiply and filter rational solutions to get other integers. For example:
Defining addition operation:
f[x_] := 9 + 108 x^2 (x + 1)
fun[{xa_, ya_}, {"O", "O"}] := {xa, ya}
fun[{"O", "O"}, {xa_, ya_}] := {xa, ya}
...
2
After some back and forth with WRI, here is the answer: the domain restriction in Reduce[] applies to the specified variables and functions involving those variables. Since no variables are specified in my first example, the domain restriction effectively does nothing. That also explains why using {} does not solve the problem.
EDIT: After reading @Michael'...
-1
Convert it to string and solve it.
convert[x_] :=
x /. (Or[(a_) && (b_)]) :> {b, a} // InputForm // ToString //
StringReplace[#, "||" -> ","] & // "Piecewise[{" ~~ # ~~ "}]" & //
ToExpression;
this works for easy situation, for example:
convert[(a <= -2 && 1 + 2 a <= y <= 1) || (-2 < a <= 2 (1 - ...
3
I suspect Reduce treats the second argument as a variable. For instance:
Reduce[2 Reals == 1, Reals]
(* Reals == 1/2 *)
So I'm not sure there's anything wrong with
Reduce[Abs[x-3] < 4, Reals]
(* Reduce[Abs[x-3] < 4, Reals] *)
However, from the docs ("Details"):
Reduce[expr,vars,dom] restricts all variables and parameters to belong to the domain ...
0
The 1st argument of a root object is a pure function, let us call it pf, which is why you see the slot object #1, which represents the unknown. The 1st argument preserves the information needed to solve the equation pf[x] == 0 when all the unevaluated symbols in the root object become known quantities.
The 2nd argument is an ordinal identifying which of ...
6
The primary issue in this question is plotting resolution. Both Plot and ContourPlot sample the function to be plotted at a finite number of locations. If none of these locations is sufficiently near a portion of the desired curve, then that portion may be missed. In this case, greatly increasing PlotPoints and setting MaxRecursion yields,
Plot[function[3,...
1
Clear["Global`*"]
roots[Lv_?NumericQ, nv_?NumericQ, kv_?NumericQ, hv_?NumericQ] :=
Module[{L, n, k, h},
{L, n, k, h} = Rationalize[{Lv, nv, kv, hv}, 0]; Solve[{
2*Cot[x] == k/(h (L/n)) x - h (L/n)/k/x,
60 > x > 0}, x, Reals]]
The exact solutions are Root objects
sol1 = roots[0.25, 20, 16, 0.1]
These are approximately
sol1 // N
(* {{x -...
4
Clear["Global`*"]
k = Sqrt[k1^2 + k2^2];
Simplify as you go along
m = {{-Sqrt[Pi/2]*I*(k1/(2*k))*Exp[-k*h],
Exp[-k*h] + Sqrt[Pi/2]*Kn*k*Exp[-k*h], 0},
{-Sqrt[Pi/2]*I*(k2/2*k)*Exp[-k*h], 0,
Exp[-k*h] + Sqrt[Pi/2]*Kn*k*Exp[-k*h]},
{(1/2*Kn)*Exp[-k*r3] - (k/2*Kn)*r3*
Exp[-k*r3] + (k/2*Kn)*h*Exp[-k*r3] + (k1^2/2*Kn*k)*r3*
...
4
Your equation might be transformed to 2 Cot[x] == x/p - p/x with a new parameter p= (h (L/n) )/k
With
p0=(h (L/n) )/k /. {L -> 0.25, n -> 20, k -> 16, h -> 0.1};
(*0.000078125*)
you might visualize the solution with ContourPlot
ContourPlot[ContourPlot[1/(2 Cot[x]) == 1/((x/p) - p/x), {x, 0, 60}, {p, 0, 2 p0},FrameLabel -> {x,"p=\!\(\*...
3
DSolve often cannot solve differential equations for which symbolic solutions actually do exist. So, out of curiosity, I attempted to solve these equations and made some progress, obtaining v'[l] in terms of u[l], and u[l] as an implicit function of l. Here is the calculation.
Obtain v'[l]:
Equal @@ (DSolve[eq2, u[l], l][[1, 1]]) /. Exp[2 C[1]] -> c
...
2
Here is a brute force approach using NumberTheory`PowersRepresentationsDump`ProbablePerfectSquareQ, which I got from this comment by JM on a question asking for the Fastest square number test.
Quiet@PowersRepresentations[];(* Just to load the necessary context *)
nums =
Table[{x, NumberTheory`PowersRepresentationsDump`ProbablePerfectSquareQ[9 + 108 x^2 (...
5
You can instruct Solve to generate all conditions using MaxExtraConditions, or you can use Reduce instead of Solve.
Solve[a + Sqrt[x^2 - b] == 0, x, MaxExtraConditions -> All]
During evaluation of Solve::useq: The answer found by Solve contains equational condition(s) {0==-a-Sqrt[a^2],0==-a-Sqrt[a^2]}. A likely reason for this is that the solution set ...
2
Memoization as a form of lazy evaluation may do what you need:
Clear[roots];
roots[a_?NumericQ] := roots[a] = z /. NSolve[z^3 + 3 z^2 - z == a, z]
Asking for a value now computes it and stores (caches) the result:
roots[2.4]
(* {-3.07116, -0.849142, 0.920299} *)
So there's no need to pre-compute a list of these.
Look at all the cached results:
?...
2
It's because a isn't actually exactly incrementing by 0.1 every time. So roots[2.4] doesn't actually have a defined value.
If we take a look at the InputForm of the arguments for the defined values of roots, then this becomes apparent.
Cases[DownValues[roots], HoldPattern[roots[x_]] :> x, ∞] // InputForm // Short
{-15., -14.9, -14.8, -14.7, -14.6, -...
5
Quick answer
Total@Table[ x /. Solve[x^i == x + 1 && x > 0][[1]] , {i, 2, 9}]//N
(*9.76035*)
7
The problem can be solved by exploiting the symmetry of the equations.
Clear["Global`*"]
Use exact values for the constants to enable an exact solution.
EDIT: corrected typo in value for α (Thanks to Akku14)
c1 = 1; c2 = 1; ξ1 = 3; ξ2 = 3; α = 1/10; τ = 3/10;
e1[p1_] := Exp[-α p1 + ξ1];
e2[p2_] := Exp[-α p2 + ξ2]
q1[p1_, p2_] := 100*e1[p1]/(1 + e1[p1] + ...
2
The region defined by the inequality is very complicated. It is unlikely that it can be described through any solve process.
cons = Simplify[(a/x^2)*(Log[x - b] + 1) - (a/x)*(1/(x - b)) - (1/x^2)*(-b^3 +
b) < 0, x > 0 && x > b] && x > 0 && x > b
(* a (-b + x) Log[-b + x] < b (a + (-1 + b^2) (b - x)) &&...
3
Better use exact values, because they have infinite precision.
Try:
NSolve[Pr[52, 0, p] == 5/100, p, Reals]
(* {{p -> 0.0559822}, {p -> 1.94402}} *)
Or:
(* exact numbers *)
Solve[Pr[52, 0, p] == 5/100, p, Reals]
(* specifying 30-digit precision *)
NSolve[Pr[52, 0, p] == 0.05`30, p, Reals]
(* machine precision returns error message *)
FindRoot[Pr[...
Top 50 recent answers are included
