# Solve and plot an equation that is dependent on a transcendental equation

I am trying to plot a function that uses the values of a transcendental equation as its input values:

y = Tanh[(2 y + x)/2.5]
z = 2.5 * Log[2*Cosh[(2 y + x)/2.5]]


for $x = [-1.5, 1.5]$.

I am a relative newbie to Mathematica, so I am at a complete loss as to how to go about this. I have successfully plotted the transcendental equation itself using ContourPlot, and mathematically I know what to do - but I can't for the life of it figure out how to make Mathematica solve these two equations and plot the result.

I find the Mathematica notation to be somewhat cryptic, but I really love the results, so I want to get good at it. Can somebody help?

-
By the way, welcome to Mathematica.SE! Please consider registering your account so that any upvotes you get on this question are added to those you might get on future questions and answers. That way, over time you will be able to do more on the site (post graphics, edit things, etc). –  Sjoerd C. de Vries May 25 at 14:04

f[x_] := y /. FindRoot[y == Tanh[(2 y + x)/2.5], {y, x}]

Plot[2.5 Log[2 Cosh[(2 f[x] + x)/2.5]], {x, -1.5, 1.5}]


1. Analyze

g[x_, d_] := y /. FindRoot[y == Tanh[(2 y + x)/d], {y, x}]

Manipulate[
Plot[g[x, d], {x, -1.5, 1.5},
PlotRange -> {-1, 1}],
{{d, 2.5}, 1, 3}]


2. Min/Max values

This example gives an idea how to redefine g:

Manipulate[
Plot[{y, Tanh[(2 y + x)/d]}, {y, -2, 2}],
{{d, 1.5}, 0, 3},
{{x, 1}, -5, 5}]

g[x_, d_: 1.5] :=
With[{x0 = If[x < 0, -1, 1]},
y /. FindRoot[y == Tanh[(2 y + x)/d], {y, x0}]]

ListPlot[Table[{x, g[x]}, {x, -2, 2, .05}],
Joined -> True]


Instead of ContourPlot you can also solve first equation for x(y) as @Alexei pointed out.

With[{d = 1.5},
Plot[d (ArcTanh[y] - 2 y), {y, -2, 2},
PlotRange -> All]]


3. Functions z(x,y) and y'(x)

Note that you can simplify your z with how y is defined.

ListPlot[Table[{x, -2.5 Log[2 Cosh[ArcTanh[g[x, 2]]]]},
{x, -2, 2, .05}], Joined -> True]


Regarding derivative, calculate that again for what you've commented is not true. Check:

Solve[y'[x] == D[Tanh[(2 y[x] + x)/d], x], y'[x]]


So you can define it like this:

dy[x_, d_: 1.5] :=
With[{y = g[x, d]},
Divide[
Sech[(2 y + x)/d]^2,
d - 2 Sech[(2 y + x)/d]^2]]

ListPlot[Table[{x, dy[x]}, {x, -2, 2, .05}]]


Because of the pole I can't force Joined -> True. I could do that if I offset x's a little in the last Table (e.g. -2 - .1). I can also do this:

Module[{dx = .05, left},
left = Table[{x, dy[x, 2]}, {x, -2, -dx, dx}];
Graphics[{
Line[left],
Line[left /. {x_, y_} :> {-x, y}]},
Axes -> True]]


-
Ditto here - that was one quick reply! :) Your solution seems simpler, but can I also use this method for the function described above (1.5 rather than 2.5 in the denominator): y = Tanh[(2 y + x)/1.5] where I want to use the minimum values of y for [-∞;0] and maximum values for [0;∞] - because this function has (is supposed to have) a jump-continuity at 0? –  nielsen May 25 at 11:46
@nielsen Right, something happens as denominator drops below 2. You can start analyzing that with Manipulate example above. –  BoLe May 25 at 12:01
@nielsen I think you should think it over again...I added few results ("chapter 3"). –  BoLe May 29 at 14:06
You are right - I have indeed done the derivative wrong. Thank you for that. And wowsa, now I have to sit down and study the syntax of the solution you have suggest closer - but at least that does confirm, that what I've been trying to do in Mathematica isn't exactly trivial - and I am a beginner at this. Thank you very much for your time - and I might still have questions, if I may? –  nielsen May 30 at 9:10
@nielsen Hey, no problem, and sure, feel free to pose questions. You might want to join chat though (top menu), there is a chat room "Discussion between BoLe and Aky", shall we converse there? Messages are stored and notifications done. –  BoLe May 30 at 10:12

Maybe you can do something like this:

nielsensFunction[x_?InexactNumberQ] :=
\[FormalY] /. First @ FindRoot[\[FormalY] - Tanh[2 (2 \[FormalY] + x)/5],
{\[FormalY], Tanh[x]}, WorkingPrecision -> Precision[x]]


I used a formal symbol as a temporary variable within FindRoot[] for safety, since they are guaranteed to never have any values assigned to them. Looking at ContourPlot[y == Tanh[2 (2 y + x)/5], {x, -15, 15}, {y, -1, 1}], the curve looked not too different from Tanh[x], so I elected to use Tanh[x] as a seed for FindRoot[].

Having done this, we can now do the following:

Plot[{nielsensFunction[x], 5 Log[2 Cosh[2 (2 nielsensFunction[x] + x)/5]]/2},
{x, -3/2, 3/2}]


-
Holy smokes, that was fast - I am duly impressed! :D Can I just ask - what if I instead want to use this function (1.5 rather than 2.5 in the denominator): y = Tanh[(2 y + x)/1.5] where I want to use the minimum values of y for [-∞;0] and maximum values for [0;∞] - because this function has (is supposed to have) a jump-continuity at 0? –  nielsen May 25 at 11:43
Right, Tanh[x], or just x, is a better seed. –  BoLe May 25 at 11:54
@BoLe, not sure about using x, as it doesn't have the same qualitative behavior... –  Ｊ. Ｍ. May 25 at 14:50
@nielsen, that requires some more work; maybe use calculus to find the range where the function is no longer one-to-one, and then build approximants appropriately. –  Ｊ. Ｍ. May 25 at 14:53

One very simple way without actually solving something is to note that form the first equation one can express x as

-2. y + 2.5 ArcTanh[y]


and that this can be substituted into the second equation, which then only depends upon y. This enables one to use the variable y as a parameter and apply the parametric plot. By playing with its limits one easily finds that the limits for the variable y are from approximately -0.855 to approximately +0.855. Evaluate this:

     ParametricPlot[{-2. y + 2.5 ArcTanh[y],
2.5*Log[2*Cosh[ArcTanh[y]]]}, {y, -0.855, 0.855},
AxesLabel -> {"x", "z"}]


-
Good point - I hadn't even noticed that! –  nielsen May 29 at 11:34