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

Question

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?

Answer 1

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]]

Answer 2

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}]

Answer 3

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"}]