# Finding the maximum real part of roots

Suppose that I have this problem

roots =
Reduce[
Sin[z + Sin[z + Sin[z]]] == Cos[z + Cos[z + Cos[z]]] &&
-3 < Re[z] < 3 && -3 < Im[z] < 3, z] // Quiet;

ListPlot[{Re[z], Im[z]} /. {ToRules[roots]},
PlotLabel ->
Style[TraditionalForm[Sin[z + Sin[z + Sin[z]]] == Cos[z + Cos[z + Cos[z]]]], 14],
PlotStyle -> Red, AspectRatio -> 1]


Thus as in https://www.wolfram.com/mathematica/newin7/content/TranscendentalRoots/PlotTheRootsOfANestedTranscendentalEquation.html
I get a beautiful solution. Suppose now that this equation depends on quantity a in a range of (1, 2).

roots[a_] :=
Reduce[
Sin[z + Sin[z + Sin[z]]] == a + a Cos[z + a Cos[z + Cos[z]]] &&
-3 < Re[z] < 3 && -3 < Im[z] < 3, z] // Quiet;  


But I don't want the real and imaginary part for each vale of a specified a, rather I would like to have a plot that is a continuous function of a, and the maximum of the real part of the z.

Is there any way to do it?

I have tried this,

Plot[Max[Re[z]] /. {ToRules[roots[a_]]}, {a, 1, 2},
PlotLabel -> PlotStyle -> Red, AspectRatio -> 1]


but it has been running for a day and I still have not got any result.

• Try discretizing the a value in the relevant range. If you assume the result to be smooth, you'll get a good approximation. May 1 '19 at 16:14

Clear["Global*"]


Use a numeric technique, i.e., NSolve.

f[a_?NumericQ] :=
Max@Re[z /.
NSolve[Sin[z + Sin[z + Sin[z]]] ==
a + Cos[z + a*Cos[z + a*Cos[z]]] && -3 < Re[z] < 3 &&
-3 < Im[z] < 3 && 1 <= a <= 2, z]]


Since f uses a numeric technique, its argument is restricted to numeric values by using PatternTest with NumericQ. Even using numeric techniques the calculations are slow.

AbsoluteTiming[data = Table[{a, f[a]}, {a, 1, 2, .025}];]

(* {803.729, Null} *)

ListLinePlot[data,
Frame -> True,
FrameLabel ->
(Style[#, 12, Bold] & /@ {"a", "Max[Re[z]]"})]


The plot is not smooth so if you were to use Plot its adaptive sampling would further increase the time required.

• It took longer for me (2673.97 seconds), but it work! Thank you so much for your clever answer! May 1 '19 at 17:57