# Solving a complicated equation of order 5. completely parametrically

I have this equation and it takes so much time to solve. i would appreciate some guidance how to solve it. 0<l<1 and 0<gamma<1 and -Pi/2<theta<Pi/2 and w is real and positive. other variable are just constant numbers and all positive.

Subscript[\[Lambda], 1] =
Subscript[s, 1]*Sqrt[q^2 + w^2 + 1] /.
q -> (w*Sin[\[Theta]] + I*\[Gamma])/Cos[\[Theta]] // FullSimplify;

Subscript[\[Lambda], 2] =
Subscript[s, 2]*Sqrt[q^2 + w^2 + l^2] /.
q -> (w*Sin[\[Theta]] + I*\[Gamma])/Cos[\[Theta]] // FullSimplify;

Solve[Subscript[\[Lambda],
1]*(l^2 + (-Subscript[\[Alpha], 2] + Subscript[\[Alpha], 3])*
Subscript[\[Lambda], 2]^2 + (1 +
Subscript[\[Alpha],
1])*(w^2 + (I*\[Gamma]*Sec[\[Theta]] +
w*Tan[\[Theta]])^2))*
((-Subscript[C, 1133])*
Subscript[\[Alpha],
3]*(w^2 + (I*\[Gamma]*Sec[\[Theta]] + w*Tan[\[Theta]])^2) +
Subscript[C,
3333]*(l^2 -
Subscript[\[Alpha], 2]*Subscript[\[Lambda], 1]^2 +
(1 +
Subscript[\[Alpha],
1])*(w^2 + (I*\[Gamma]*Sec[\[Theta]] +
w*Tan[\[Theta]])^2))) -
Subscript[\[Lambda],
2]*(l^2 + (-Subscript[\[Alpha], 2] + Subscript[\[Alpha], 3])*
Subscript[\[Lambda], 1]^2 +
(1 +
Subscript[\[Alpha],
1])*(w^2 + (I*\[Gamma]*Sec[\[Theta]] +
w*Tan[\[Theta]])^2))*((-Subscript[C, 1133])*
Subscript[\[Alpha],
3]*(w^2 + (I*\[Gamma]*Sec[\[Theta]] + w*Tan[\[Theta]])^2) +

Subscript[C,
3333]*(l^2 -
Subscript[\[Alpha], 2]*
Subscript[\[Lambda], 2]^2 + (1 +
Subscript[\[Alpha],
1])*(w^2 + (I*\[Gamma]*Sec[\[Theta]] +
w*Tan[\[Theta]])^2))) == 0, w]

• You have an equation of the order 4 with huge coefficients that have generic values. The solution of such an equation one, in principle, can get with Mathematica using a few simple tricks. However, it will be (1) huge and, therefore, (2) useless. That is, one will be unable to analyze it or use it further. Commented Apr 7, 2023 at 10:23
• @AlexeiBoulbitch It turns out that there are either four or six solutions depending on the values of the parameters. Commented Apr 8, 2023 at 12:38
• @bbgodfrey Did you understand my answer such that I think that there is only one solution to the equation of the fourth order? No. The word "one" stays in my answer as a part of the expression "one can get..." Commented Apr 8, 2023 at 15:34

Considerable progress can be made as follows. First, replace Subscript in the equation, because it slows calculations and is inconvenient besides. This can be done by defining

f[z1_, z2_] := ToExpression[StringJoin @@ (ToString /@ {z1, z2})]


and then use /.Subscript -> f on the equation appearing in Solve in the question. The result is

eq =
s1 Sqrt[1 + w^2 + (I γ Sec[θ] + w Tan[θ])^2] (l^2 + (1 + α1) (w^2 + (I γ
Sec[θ] + w Tan[θ])^2) + s2^2 (-α2 + α3) (l^2 + w^2 + (I γ Sec[θ] +
w Tan[θ])^2)) (-C1133 α3 (w^2 + (I γ Sec[θ] + w Tan[θ])^2) +
C3333 (l^2 + (1 + α1) (w^2 + (I γ Sec[θ] + w Tan[θ])^2) -
s1^2 α2 (1 + w^2 + (I γ Sec[θ] + w Tan[θ])^2))) -
s2 Sqrt[l^2 + w^2 + (I γ Sec[θ] +  w Tan[θ])^2] (l^2 + (1 + α1) (w^2 + (I γ
Sec[θ] + w Tan[θ])^2) + s1^2 (-α2 + α3) (1 + w^2 + (I γ Sec[θ] +
w Tan[θ])^2)) (-C1133 α3 (w^2 + (I γ Sec[θ] + w Tan[θ])^2) +
C3333 (l^2 + (1 + α1) (w^2 + (I γ Sec[θ] + w Tan[θ])^2) -
s2^2 α2 (l^2 + w^2 + (I γ Sec[θ] + w Tan[θ])^2))) == 0


Notice that w appears only in the combination, w^2 + (I γ Sec[θ] + w Tan[θ])^2, so significant simplification can be achieved by the substitution,

eq1 = eq /. w^2 -> x - (I γ Sec[θ] + w Tan[θ])^2
(* -s2 Sqrt[l^2 + x] (C3333 (l^2 + x (1 + α1) - s2^2 (l^2 + x) α2) -
C1133 x α3) (l^2 + x (1 + α1) + s1^2 (1 + x) (-α2 + α3)) +
s1 Sqrt[1 + x] (C3333 (l^2 + x (1 + α1) - s1^2 (1 + x) α2) -
C1133 x α3) (l^2 + x (1 + α1) + s2^2 (l^2 + x) (-α2 + α3)) == 0 *)


with w obtained from x by

Simplify[Solve[w^2 + (I γ Sec[θ] + w Tan[θ])^2 == x, w], -Pi/2 < θ < Pi/2]
(* {{w -> -Cos[θ] (Sqrt[x + γ^2] + I γ Tan[θ])},
{w -> Sqrt[x + γ^2] Cos[θ] - I γ Sin[θ]}} *)


An obvious choice to obtain real w > 0 is θ = 0, which yields, w -> Sqrt[x + γ^2], positive real for x > -γ^2. An approach for obtaining x begins by eliminating the Sqrts from eq1 and factoring the result.

eq1sq = Subtract @@ (eq1[[1, 1]]^2 == eq1[[1, 2]]^2);
fac1 = FactorList[eq1sq];
LeafCount /@ First[Transpose[%]]
(* {1, 24, 4908} *)


The second factor is of manageable size and can be solved readily.

x12 = Solve[fac1[[2, 1]] == 0, x] // Simplify // Flatten
(* {x -> (-s1^2 + l^2 s2^2)/(s1^2 - s2^2)} *)


That it actually satisfies the original equation is verified by

Simplify[eq1 /. x12, s1 > 0 && s2 > 0]
(* True *)


Here is a sample plot of w vs {s1, s2}

Quiet@Plot3D[Sqrt[(-s1^2 + l^2 s2^2)/(s1^2 - s2^2) + γ^2]
/. {l -> 1/2, γ -> 1/2}, {s2, 0, 5}, {s1, 0, 5},
AxesLabel -> {s2, s1, w}, PlotLabel -> "{l -> 1/2, γ -> 1/2}",
LabelStyle -> {Bold, Black}, PlotPoints -> 100]


The larger factor also can be solved by

Collect[fac1[[3, 1]], x, Simplify];
Solve[% == 0, x]


but the four resulting solutions are unmanageably complicated. Moreover, two or three of them (depending on the choice of parameter values) do not satisfy the original equation. Of course, eq1 can be solved numerical for any specific parameters; i.e.,

param1 = C1133 -> 0.820599, C3333 -> 0.84379, l -> 0.157808, s1 -> 0.94172,
s2 -> 0.768998, α1 -> 0.651002, α2 -> 0.8877, α3 -> 0.474658}
Flatten@Solve[Simplify[0 == eq1 /. SetPrecision[param1, 30]]]
(* {x -> -2.951519117927659465922, x -> -2.096574605386734359552,
x -> -0.01329052999440164484502} *)


The third root leads to a positive real value for w for most values of γ.