3
$\begingroup$

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.

$\endgroup$
  • 1
    $\begingroup$ Try discretizing the a value in the relevant range. If you assume the result to be smooth, you'll get a good approximation. $\endgroup$ – Kagaratsch May 1 at 16:14
6
$\begingroup$
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]]"})]

enter image description here

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

$\endgroup$
  • $\begingroup$ It took longer for me (2673.97 seconds), but it work! Thank you so much for your clever answer! $\endgroup$ – vanessa May 1 at 17:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.