# Does a positive real solution exist to this problem?

I wrote the following code for getting the solution. I am not sure if the code I wrote is correct. The problem is further intensified by the fact that I don't know if a solution exists to this problem with the set constraints.

Reduce[1/2 (a Cos[k] + b Cos[k] + c Cos[k] - a Cos[k - 2 x] -
b Sin[k - \[Pi]/6 - 2 x] + c Sin[k + \[Pi]/6 - 2 x]) == 3/2 d &&
x \[Element] Interval[{0, 2 \[Pi]}]  && 1 > a > 0 && 1 > b > 0 && 1 > c > 0 &&
d > 0, k, Reals]


Here, $$a,b,c,d$$ are constants and can take values from the interval $$(0,1]$$. $$x$$ varies from $$[0,2\pi]$$. The desired solution i.e. $$k$$ must be a real number. So following are my questions:-

1. Is the line of code I have written correct? If not, please help me in rectifying it. If yes, please suggest me a way for arriving at the solution (if it exits).
2. Is there a way of just seeing if the solution exists for this type of problems without actually computing the solution?

Thanks in advance. Appologies if I haven't been able to clearly state my problem. Inconvenience regretted.

• Solve[1/2 (TrigExpand[ a Cos[k] + b Cos[k] + c Cos[k] - a Cos[k - 2 x] - b Sin[k - \[Pi]/6 - 2 x] + c Sin[k + \[Pi]/6 - 2 x]]) == 3/2, k] produces a big expression. Too many parameters for Reduce over the reals. Commented Apr 1, 2021 at 16:07
• If you set x==k==0 and b==c==d==1 you have a solution Commented Apr 1, 2021 at 16:16
• @DanielHuber: But k is the unknown vaiable. Commented Apr 1, 2021 at 16:21
• @DanielHuber I don't want a particular solution of the problem. I want the general solution of k for any arbitary values of a,b,c and d, according to the set constraints. Commented Apr 1, 2021 at 16:24
• At least you know that at least one solution exists Commented Apr 1, 2021 at 16:28

This problem can be solved symbolically by means of the Weierstrass Substitution.

ex = (a Cos[k] + b Cos[k] + c Cos[k] - a Cos[k - 2 x] -
b Sin[k - π/6 - 2 x] + c Sin[k + π/6 - 2 x]) - 3 d;

Collect[TrigExpand[ex], {Cos[k], Sin[k]}, Simplify[#, Trig -> False] &];
Simplify[(t^2 + 1) % /. {Sin[k] -> 2 t/(1 + t^2), Cos[k] -> (1 - t^2)/(1 + t^2)}];
s = Solve[% == 0, t] // Simplify // Values // Flatten

(* {-((-Sqrt[3] b Cos[2 x] + Sqrt[3] c Cos[2 x] - 2 a Sin[2 x] + b Sin[2 x] + c Sin[2 x] +
2 √(2 a^2 + a b + 2 b^2 + a c + b c + 2 c^2 - 9 d^2 + (-2 a^2 - a (b + c) +
(b + c)^2) Cos[2 x] + Sqrt[3] (b - c) (a + b + c) Sin[2 x]))/
(-2 (a + b + c + 3 d) + (2 a - b - c) Cos[2 x] - Sqrt[3] (b - c) Sin[2 x])),
(Sqrt[3] b Cos[2 x] - Sqrt[3] c Cos[2 x] + 2 a Sin[2 x] - b Sin[2 x] - c Sin[2 x] +
2 √(2 a^2 + a b + 2 b^2 + a c + b c + 2 c^2 - 9 d^2 + (-2 a^2 - a (b + c) +
(b + c)^2) Cos[2 x] + Sqrt[3] (b - c) (a + b + c) Sin[2 x]))/
(-2 (a + b + c + 3 d) + (2 a - b - c) Cos[2 x] - Sqrt[3] (b - c) Sin[2 x])} *)


and k is given by 2 ArcTan[t]. It is real, if

(2 a^2 + a b + 2 b^2 + a c + b c + 2 c^2 - 9 d^2 + (-2 a^2 - a (b + c) +
(b + c)^2) Cos[2 x] + Sqrt[3] (b - c) (a + b + c) Sin[2 x]) >= 0


Numerical values can be obtained by, for instance,

SeedRandom[1066];
r = Join[Thread[{a, b, c, d} -> RandomReal[{0, 1}, 4]], {x -> RandomReal[{0, 2 Pi}]}]
(* {a -> 0.480113, b -> 0.312575, c -> 0.457035, d -> 0.230827, x -> 3.62822} *)
sn = (k -> 2 ArcTan[#]) & /@ (s /. r)
(* {k -> 0.876737, k -> -0.892127} *)


Running numerous such numerical evaluations indicates that solutions are real about half the time.

• See my comment to the question where Solve works without any substitution. Commented Apr 2, 2021 at 4:48

Here's how you can solve it numerically to get other approximate solutions besides those already discussed in the comments. Minimize the integral of the square error between left and right sides of the equation:$$\underset{a,b,c,d,k}{\mathrm{argmin}}\int_{0}^{2\pi}(\mathrm{lhs}-\mathrm{rhs})^2 dx$$

eqn = 1/2 (a Cos[k] + b Cos[k] + c Cos[k] - a Cos[k - 2 x] -
b Sin[k - π/6 - 2 x] + c Sin[k + π/6 - 2 x]) == 3/2 d;

eqz = (eqn /. Equal -> Subtract);

intg = Integrate[eqz^2, {x, 0, 2 π}];

{err, sol} = NMinimize[{intg, 0 < a <= 1, 0 < b <= 1, 0 < c <= 1, 0 < d <= 1, k > 0},
{a, b, c, d, k}, WorkingPrecision -> 40];

(* the plot of the error should stay very close to zero *)
Plot[eqz /. sol, {x, 0, 2 π}]


From this I get what looks like $a = b = c$ and the values:

{a -> 0.7407676298101783761156954580402392081913,
b -> 0.7407676298101783761455502947765225634654,
c -> 0.7407676298101783761328473487740510301014,
d -> 0.6130660961238245076636024095039218273303,
k -> 0.5959614992855459592789335254668571684626}


A solution with distinct $$a,b,c,d$$ doesn't exist:

Reduce[intg == 0 && 0 < a <= 1 && 0 < b <= 1 && 0 < c <= 1 && 0 < d <= 1
&& a != b && a != c && a != d && b != c && b != d && c != d
, {a, b, c, d, k}, Reals]

(* False *)

• I personally want an answer for the case when a,b and c are distinct Commented Apr 1, 2021 at 16:26
• It's only by removing the distinct (not-equal) constraints that Reduce gives a solution: C[1] \[Element] Integers && 0 < a <= 1 && b == a && c == a && 0 < d <= a && (k == -2 ArcTan[Sqrt[(a - d)/(a + d)]] + 2 \[Pi] C[1] || k == 2 ArcTan[Sqrt[(a - d)/(a + d)]] + 2 \[Pi] C[1]) Commented Apr 1, 2021 at 16:31