New answers tagged equation-solving
2
Clear["Global`*"]
t = 0.0005 // Rationalize;
r = 0.00025 // Rationalize;
A = 0.06 // Rationalize;
B = -0.01 // Rationalize;
s = 0.015 // Rationalize;
i = 0;
M = w*A - i*B;
U = t/(1 + t*w - t*i);
P = (s/t)*(1 + U*(r + t));
Note that equations use Equal ( == ) not Set ( = )
eqn1 = Q == M/P // Simplify
(* Q == (8 w (2000 + w))/(8000003 + 4000 w) *)
...
1
I do not believe that your second DSolve gives the inverse of y. In any case, it is easy to plot the inverse. With Ulrich Neumann's answer as a starting plot, use
ParametricPlot[{{(y[x] /. sol)[[2]] /. {y1 -> 3/10, a -> 13/10, b -> 7/10}, x},
{(y[x] /. sol)[[1]] /. {y1 -> 3/10, a -> 13/10, b -> 7/10}, x}},
...
1
Without specifying a,b, introduce an initial condition y[1]==y1 in your ode. DSolve evaluates two solutions depending on x,y1,a,b
Clear["Global`*"]
sol = FullSimplify[DSolve[{Derivative[1][y][x] + (3/2)*(a - b)*(y[x]/x) - ((3/2)*a - 1)*(1/(y[x]*x^3)) == 0, y[1] == y1}, y[x], x]]
$\left\{\left\{y(x)\to -\frac{\sqrt{x^{3 b-3 a}\left(\text{y1}^2 (3 a-...
1
LogNormalSolver does not know about the local variables in getLaw. One solution would be to pass those variables to LogNormalSolver, so that it expresses its solution in terms of them
LogNormalSolver[mat_, lam_, zeta_] :=
NSolve[{mat[[1]] == Exp[lam + zeta^2/2],
mat[[2]] == Exp[lam + zeta^2/2]*Sqrt[Exp[zeta^2] - 1],
lam \[Element] Reals, zeta &...
2
ClearAll["Global`*"]
arr = Cases[
Import[
"/Users/roberthanlon/Downloads/data.txt", "CSV"],
{_Integer ..}, 1];
Length@arr
(* 27060 *)
Verifying that every line of arr matches the template {Sqrt[s], Sqrt[t], Sqrt[u], s, t, u, t+u, t+u-s, t-s}
And @@ ((repl = Thread[{s, t, u} -> #[[4 ;; 6]]];
# == ({Sqrt[s], ...
2
Normal@Plot[{F, G}, {x, 0, 3},
PlotRange -> {-1, 2}, PlotPoints -> 300,
PlotLegends -> "Expressions", AxesLabel -> Automatic,
MeshFunctions -> {Function[x, Re@F // Evaluate]} // Evaluate,
MeshStyle -> Red, Mesh -> {{0}}] /.
Point[p_] :> Point[p /. {x_Real, y_Real} :> {x, 1.5}]
One of the roots of F is not ...
1
You may use the Exclusions option of Plot.
First define your functions with SetDelayed to prevent variable scope issues.
Clear[f, g, x, y]
f[x_, y_] := -((3 Sin[3 x])/(2 x)) -
Sqrt[-1 + (Cos[3 x] + (2 Sin[3 x])/x + (Cos[2 x] - Cos[y]) Csc[2 x] Sin[3 x])^2]
g[x_, y_] := Cos[3 x] + ((1 + 2 x Cot[2 x] - x Cos[y] Csc[x] Sec[x]) Sin[3 x])/(2 x)
The Exclusions ...
3
Use lower case names, otherwise there is danger of a conflict with built in names. You use "I" what in MMA is the imaginary unit. I therefore replaced it by W. In addition using the hint from Bob Halon:
sol = Solve[{A - β S (W + ρ1 T) - (μ + p) S == 0,
p S - ρ2 β V (W + ρ1 T) - μ V == 0,
l β S (W + ρ1 T) + ρ2 β V (W + ρ1 T) - \
(μ + δ) L +...
4
Clear["Global`*"]
You have five equations with only four unknowns. Use the option MaxExtraConditions. The use of FullSimplify slows this down considerably.
sol = Solve[{
A - β S (i + ρ1 T) - (μ + p) S == 0,
p S - ρ2 β V (i + ρ1 T) - μ V == 0,
l β S (i + ρ1 T) + ρ2 β V (i + ρ1 T) - (μ + δ) L + ρ T == 0,
(1 - l) β S (i + ρ1 T) + δ L -...
4
We can solve this problem with using numerical method developed in our recent paper and based on Euler wavelets. First we define wavelets and all functions to be computed
UE[m_, t_] := EulerE[m, t]
psi[k_, n_, m_, t_] :=
Piecewise[{{2^(k/2) Sqrt[2/Pi] UE[m, 2^k t - 2 n + 1], (n - 1)/
2^(k - 1) <= t < n/2^(k - 1)}, {0, True}}]
PsiE[k_, M_, t_] :=...
3
Review
y=-1
Except NSolve or Reduce, none of the other three methods can include all the root!
We can compare the four pictures.
f[x_, y_] = -((3 Sin[3 x])/(2 x)) -
Sqrt[-1 + (Cos[3 x] + (2 Sin[3 x])/
x + (Cos[2 x] - Cos[y]) Csc[2 x] Sin[3 x])^2];
g[x_, y_] =
Cos[3 x] + ((1 + 2 x Cot[2 x] - x Cos[y] Csc[x] Sec[x]) Sin[
3 x])/(2 x);
...
6
Your system of equations can be written in matrix form:
M = {{1, 1, -3, 4},
{2, 5, -6, 2},
{3, -4, 5, -3}};
q = {4, 15, 10};
Thread[M . {a, b, c, d} == q]
(* {a + b - 3 c + 4 d == 4,
2 a + 5 b - 6 c + 2 d == 15,
3 a - 4 b + 5 c - 3 d == 10} *)
As @DanielHuber points out, there are infinitely many solutions $x=\{a,b,c,d\}$. The ...
4
Here is an example:
eq = {a + b - 3 c + 4 d == 4, 2 a + 5 b - 6 c + 2 d == 15,
3 a - 4 b + 5 c - 3 d == 10};
Solve[eq, {a, b, c}]
Solve[eq, {a, b, d}]
Solve[eq, {a, c, d}]
Solve[eq, {b, c, d}]
1
Clear["Global`*"]
sol[eq_] := Solve[Cases[eq1,
c_ *_Dot :> c, Infinity] == 0];
eq1 = (a[3] - a[4]) ψ . ξ + (a[1] + 2 a[2]) ψ . ϕ;
sol[eq1]
(* {{a[2] -> -(a[1]/2), a[4] -> a[3]}} *)
For the original problem,
eqns = {
(a[3] - a[4]) ψ . ξ + (a[1] + 2 a[2]) ψ . ϕ,
2 (a[3] - a[4]) ψ . ξ,
(a[1] + a[2] + a[3] + a[4]) ψ . ϕ};
...
2
What about `SolveAlways?
var = {\[Psi] . \[Xi], \[Psi] . \[Phi]}
SolveAlways[eq1 == 0, var]
(*{{a[1] -> -2 a[2], a[3] -> a[4]}}*)
0
Probably you want to solve eqnsfor y[x] !
Try
Clear["Global`*"]
eqns = {3/2 (\[Gamma] - \[Lambda]) y[x]/x - (3/2 \[Gamma] - 1) 1/(y[x] x^3) == (3 \[Xi])/2}
sol = Solve[eqns, y[x]]
y1[x_] = y[x] /. sol[[1]];
y2[x_] = y[x] /. sol[[2]];
DSolve[{y1[x[t]] == x'[t]/x[t]}, x[t], t]
DSolve[{y2[x[t]] == x'[t]/x[t]}, x[t], t]
Now your code evaluates!
...
0
eqns = {x + y + z == 1, x - 2 y + 4 z == 2, x + y == 1};
Grid[{
{Style["{", 18*Length@eqns, Gray], First@eqns},
Sequence @@ ({SpanFromAbove, #} & /@ (Rest@eqns))},
Alignment -> {{Right, "=="}, Center}]
3
One thing is how one solves a system of equations. This way is demonstrated above in the comment of Nasser. No palette is needed.
Here adding small explanations, I repeat what @Nasser has already written in the comment.
In Mma one writes an equation using the doubled equality symbol. That is ==, rather than =.
The function for solving algebraic equations ...
6
$Version
(* "13.0.0 for Mac OS X x86 (64-bit) (December 3, 2021)" *)
Clear["Global`*"]
eq1 = (a[3] - a[4]) ψ . ξ + (a[1] + 2 a[2]) ψ . ϕ;
eq2 = 2 (a[3] - a[4]) ψ . ξ;
eq3 = (a[1] + a[2] + a[3] + a[4]) ψ . ϕ;
var = Variables[Level[{eq1, eq2, eq3}, {-1}]]
(* {ξ, ϕ, ψ} *)
sol = Select[Solve[{eq1, eq2, eq3} == 0],
FreeQ[#, ...
6
I am not sure if I have full understand the problem. Here just provide a thinking.
conditions =
ForAll[{a1, a2, b1, b2},
a1*a2 <= -e + (x/2)^2 &&
b1*b2 <= -f + (y/2)^2, (a2 b1 + a1 b2 + x*y/2 -
z)^2 - (1/
2 Sqrt[-4 a1 a2 - 4 e + x^2] Sqrt[-4 b1 b2 - 4 f + y^2])^2 !=
0]
Resolve[conditions, Reals]
Reduce[conditions, ...
5
Do not have time to make a full Manipulate, but you can start with
Clear["Global`*"]
g[t_]:=((1-b) y[t]^2/t^n+1/t^(2+n))^n;
ode=y'[t]+3/2 (a-b) y[t]/t+(3/2 a-1)/y[t] t^3==g[t];
pfun=ParametricNDSolveValue[{ode/.{a->3/4,b->5},y[1]==1},y,{t,1,2},{n}]
Plot[Evaluate[Table[pfun[n][t],{n,Range[5]}]],{t,1,2},
PlotRange->{Automatic,{-10,10}},...
2
$Version
(* "13.0.0 for Mac OS X x86 (64-bit) (December 3, 2021)" *)
Clear["Global`*"]
eqn = t^3 + p*t + q == 0;
solRad = Assuming[4 p^3 + 27 q^2 < 0,
Solve[eqn, t] // ToRadicals // Simplify]
(* {{t -> (-2 3^(1/3) p + 2^(1/3) (-9 q + Sqrt[12 p^3 + 81 q^2])^(2/3))/(
6^(2/3) (-9 q + Sqrt[12 p^3 + 81 q^2])^(1/3))},
{t -&...
4
Edit
FindRoot[Derivative[2][SinIntegral][x], {x, 1/2}]
{x -> 1.15898*10^-10}
sol=NSolve[{Derivative[2][SinIntegral][x], 0 < x < 6 Pi}, x]
{{x -> 4.49341}, {x -> 7.72525}, {x -> 10.9041}, {x -> 14.0662}, {x -> 17.2208}}
The concave and convex parts as below.
Plot[SinIntegral[x], {x, 0, 6 Pi}, Mesh -> {sol}, MeshStyle -> Red,
...
1
Reduce or Method->Reduce in Solve are powerful then only use Solve.
Reduce[{8 + a2 b1 + a1 b2 + 2 Sqrt[-5 - a1 a2] Sqrt[-5 - b1 b2] == 0,
a1*a2 <= -5, b1*b2 <= -5}, {a1, a2, b1, b2}]
False
Change b1*b2<=-5 to b1+b2<=-5
Reduce[{8 + a2 b1 + a1 b2 + 2 Sqrt[-5 - a1 a2] Sqrt[-5 - b1 b2] == 0,
a1*a2 <= -5, b1 + b2 <= -5}, {a1, a2, ...
1
You could try to solve the problem in a different way. E.g. by defining regions and check if there is an empty intersection:
r1 = ImplicitRegion[-36 - 20 a1 a2 + 16 a2 b1 + a2^2 b1^2 +
16 a1 b2 - 20 b1 b2 - 2 a1 a2 b1 b2 + a1^2 b2^2 == 0, {a1, a2, b1,
b2}];
r2 = ImplicitRegion[a1*a2 <= -5 && b1*b2 <= -5, {a1, a2, b1, b2}];
...
3
A somewhat different way is as follows.
s = DSolve[{op[r][op[r][f[r]]] == 0, f[b] == 0, f'[b] == 0}, f, r]
{{f -> Function[{r}, (1/( 4 b^2))(-b^4 C[1] + 2 b^2 r^2 C[1] - r^4 C[1] + b^4 C[2] - b^2 r^2 C[2] - b^4 C[2] Log[b] - r^4 C[2] Log[b] + 2 b^2 r^2 C[2] Log[r])]}}
Resolve[Exists[{C[1], C[2]},Simplify[f'[1 + b]/(1 + b)^2 - f''[1 + b]/(1 + b) + f'''...
4
For general values of $b$ and $c$, the trivial solution is indeed the only solution. However, there are special values of $b$ and $c$ which can yield non-trivial solutions.
To find these, we can start by telling Mathematica to find the general solution to the ODE:
soln = DSolve[{op[r][op[r][f[r]]] == 0}, f, r]
(* {f -> Function[{r}, (r^2 C[1])/2 - (r^2 ...
1
thanks to @DanielHuber, I found the issue.
Reduce[Exists[{i, f, j, f1, f2, N},
i == iPP && f == fPP && j == jPP && f1 == f1PP && f2 == f2PP &&
N == NPP && j >= N && iP == i + j - N && jP == N &&
f1P == f2* Fibonacci[j - N] + f1*Fibonacci[1 + j - N] &&
f2P == f2 *...
0
If I understand your problem correctly, you might solve the problem in one step
sol=DSolve[{a*y'[t] == b*y[t]^2 + f*y[t]+ d,
y[t] == x'[t]/x[t],
y[t0] == 1}, {x, y}, t]
3
Edit
The surface still have some holes.
eqs = {-0.001 z1 + (0.001 + 0.1 z1) (1 - z1 - z2 - z3 - z4) -
0.06 z1 (z3 + z4) == 0,
0.001 z1 - 0.011 z2 + (0.05 + x (1 - y)) z3 - 0.6 z2 (z3 + z4) ==
0, (1 - z1 - z2 - z3 - z4) (0.001 + 0.6 z3 + 0.6 z4) - (0.05 +
x) z4 == 0,
0.001 z2 - (0.06 + x (1 - y)) z3 + 0.06 z1 (z3 + z4) +
0.6 ...
3
Another way is Reduce the expr before use FindInstance.
FindInstance[Reduce[expr, Reals], Reduce`FreeVariables[expr], Reals,2]
6
FindInstance depends on the order of variables. In your example, you can reorder the variables (as Bob does in his answer) to get things to work:
expr = Subscript[W,1]^2 - 4 Subscript[W,0] Subscript[W,2] > 0 &&
Subscript[X,1]^2-4 Subscript[X,0]>0 &&
Subscript[Y,1]^2-4 Subscript[Y,0]>0 &&
Subscript[Z,1]^2-4 ...
3
Get a result with Solve in a second, substituting the coefficients of t und u and then reinsert.
Curve1[t_, p1_List, p2_List] = (1 - t) p1 + t p2;
Curve2[t_, p1_List, p2_List, p3_List] = (1 - t)^2 p1 +
2 t (1 - t) p2 + t^2 p3;
Curve3[t_, p1_List, p2_List, p3_List, p4_List] = (1 - t)^3 p1 +
3 t (1 - t)^2 p2 + 3 t^2 (1 - t) p3 + t^3 p4;
equ =...
5
It is generally recommended to avoid subscripted variables and instead to use indexed variables. The indexed variables can be formatted to display as the corresponding subscripted variables.
Clear["Global`*"];
SeedRandom[1234];
(Format[#[n_]] := Subscript[#, n]) & /@ {S, W, X, Y, Z};
sys1 = W[1]^2 - 4 W[0] W[2] > 0 && -4 X[0] + X[...
2
You can solve it in 2 stages. First we solve the first equitation for u:
sol1 = Solve[equ[[1]], u]
Then we use this in the second equitation to get "t":
sol2 = Solve[equ[[2]] /. sol1, t]
Now we can get the solution for u:
solu = u /. sol1 /. solt
And the solution for t:
solt = t /. sol2
Note: solution pairs {t,u} are contained in: {solt[[i]],...
2
Rather than attempt to find the error, I rewrote the code - still using For-loops - to avoid the kernel crash and also to reduce runtime a bit. The result is
Clear[F];
For[Liste2 = {}; ω = 0.3, ω <= 1, ω = ω + .01,
For[Liste = {}; λ = 2*Pi/ω; Nz = 0, Nz <= 150, Nz++,
F[t_?NumericQ] := Piecewise[{{2*t/λ, 0 < t <= λ/2}, {1, λ/2 < t <= ...
2
eq = {Exp[t (m + n)] (-b + k Sinh[t] - Sqrt[-b^2 + k^2 Sinh[t]^2]) ==
0, {m, n} \[Element] PositiveIntegers, b > 0, k > 0};
Solve[eq, t]
2
Look at your syntax. You are using comma instead of semicolon at the end of line. It should be like this:
Liste = {};
\[Omega] = \[Omega] + 0.01;
\[Lambda] = 2*Pi/\[Omega];
...
3
Not that I know a single command that could do such an operation. Here one needs to work a bit. Let us see the example of the cubic equation:
sl = Solve[x^3 + p*x + q == 0, x]
(* {{x -> -(((2/3)^(1/3) p)/(-9 q + Sqrt[3] Sqrt[4 p^3 + 27 q^2])^(
1/3)) + (-9 q + Sqrt[3] Sqrt[4 p^3 + 27 q^2])^(1/3)/(
2^(1/3) 3^(2/3))}, {x -> ((1 + I Sqrt[3]) p)/(...
8
OK, let me extend my comment to an answer. First of all, I'd like to point out that OP's observation
the zero boundary condition doesn't seem to hold
isn't really a problem here. Though ibcinc warning does pop up, and the zero boundary condition is not exactly hold, the error is rather small in this case. For more info you may refer to the this post. The ...
1
NMinimize[{x, Subscript[d, 1] > 0, Subscript[d, 2] > 0, -8.5 < Subscript[A, 0] < 1, -0.2 <
Subscript[A, 1] < 6.7, -3 < Subscript[A, 2] < 5, 0 < Subscript[B, 0] < 27.5,
0 < Subscript[B, 1] < 8.25, -2 < Subscript[B, 2] < 8, -1 < x < 1, -1/2 < y < 1/2,
0 < z < 1, -1 < w < 1, -1 < v < 1, -...
8
MethodOfLines gives a solution to your problem:
b = 200;
P = NDSolveValue[{D[p[x, t],t] == (12 x^2 - 4) p[x, t] + (4 x (x^2 - 1) + 0.1)*D[p[x, t], x] + D[p[x, t]/b, {x, 2}],
p[x, 0] == Exp[-x^2/2]/Sqrt[2 Pi], p[-3, t] == 0, p[3, t] == 0},
p, {x, -3, 3}, {t, 0, 0.5},
Method -> {"MethodOfLines", "TemporalVariable" -> t,
"...
2
You can get a sense of the ranges just by plotting where the discriminant vanishes.
aa[0] = (x^2 - y^2) + x*z;
aa[1] = x^2 + y^2 + z^2 + Sin[z];
aa[2] = x^4 + y^3 + z^2;
poly = Array[aa, 3, 0].t^Range[0, 2];
disc = Discriminant[poly, t];
bounds = {-5/4 <= aa[0] <= 2,
-1/5 <= aa[1] <= 19/5, -1 <= aa[2] <= 3,
-1 <= x <= 1, -1 <= ...
3
Edit
Another way is use Rationalize to the values k and A
function[k_, A_, u1_, u2_] := (1 + Tanh[k (u1 - 2 A u2)])/2 - u1;
results[k_, A_] :=
NSolve[function[Rationalize@k, Rationalize@A, u1, u2] == 0 &&
function[Rationalize@k, Rationalize@A, u2, u1] == 0 &&
0 <= u1 <= 1 && 0 <= u2 <= 1, {u1, u2}]
values = Range[...
3
Try Map (don't know why Table doesn't work)
Map[results[0.2, #] &, { 2.2, 2.4, 0.1}] // Quiet
(*{{{u1 -> 0.375147, u2 -> 0.375147}},
{{u1 -> 0.364816,u2 -> 0.364816}},
{{u1 -> 0.54336, u2 -> 0.54336}}}*)
Edit
I still do not understand why NSolve (numerical solver!) only evaluates with Rationalize!
NMinimize solves without this ...
1
Clear["Global`*"];
eqns = {y[x]^2 - ((1/52)*Sqrt[3]*y[x]) Sqrt[
y[x]^2 + (x)^-2/1000 - (69/100)] + ((49 (x)^-2)/100000) - (69/100) ==
0} /. x -> x[t]; y0 = 71; eqns2 = eqns /. y[x[t]] :> x'[t]/(y0 x[t]);
Use arbitrary-precision
sol = NDSolve[Append[eqns2, x[1] == 1], x, {t, 1, 10}, WorkingPrecision -> 15]
Note the domains of ...
1
To answer your question:
Notice the change in definition of f[x], g[x]
Clear[f, g, a]
f[x_] = x^3 - 6*x^2 + 11*x - 6
g[x_] = D[f[x], x]
a[0] = 0;
Do[a[n + 1] = a[n] - N[f[a[n]]/g[a[n]]], {n, 0, 7}]
Table[a[n], {n, 0, 7}]
{0, 0.545455, 0.848953, 0.974674, 0.999092, 0.999999, 1., 1.}
Save your work before you run such loops.
To help you understand it further:...
4
This would be more idiomatic:
Clear[f, g, newtonIteration]
f[x_] := x^3 - 6*x^2 + 11*x - 6
g[x_] = D[f[x], x];
newtonIteration[previousEstimate_] :=
previousEstimate - f[previousEstimate]/g[previousEstimate]
FixedPointList[
newtonIteration,
0. (* starting value *),
100 (* max number of iterations *)
]
(* Out: {0., 0.545455, 0.848953, 0.974674, 0....
1
There are two ways for two arbitrary regions, the easy one is by the convenient of ConvexHullRegion.
Manipulate[
Graphics[{{EdgeForm[Red], FaceForm[],
ConvexHullRegion[
RegionUnion[Disk[p[[1]], r1], Disk[p[[2]], r2]]]}, {EdgeForm[
Blue], FaceForm[], Disk[p[[1]], r1], Disk[p[[2]], r2]}},
PlotRange -> 10, Frame -> True], {{p, {{-3, 1},...
1
circles = MapThread[Circle, {##}] &;
tangentLines = If[Or[RegionWithin[##], RegionWithin[#2, #]]& @@ MapThread[Disk, {##}],
{}, InfiniteLine @@@ MaximalBy[MeshPrimitives[#, 1], ArcLength, 2] & @
ConvexHullMesh[Join @@ MapThread[CirclePoints[##, 100] &, {##}]]] &;
Manipulate[Graphics[{circles[p, {r1, r2}], Red, tangentLines[p, {...
Top 50 recent answers are included