# Analytical value of minima of a function involving Logarithm and exponential

I am trying to derive the analytical expression for the point of minima of the function $$\frac{c+ x \ln(-2+2 e^{c/x})-\ln (-1+e^{2c/x})}{x [\ln(-1+e^{c/x})-\ln (-1+e^{2c/x}) ]}$$ Here $$x$$ is the variable and $$c$$ is a constant. Plot of the function for a specific $$c$$ value is shown in the figure: Mathematica code:

(c + x (Log[-2 + 2 E^(c/x)] -
Log[-1 + E^((2 c)/x)]))/(x (Log[-1 + E^(c/x)] -
Log[-1 + E^((2 c)/x)]))


Any help will be appreciated. I have also asked this question on mathematics stack exchange.

• To @Mark Robinson. Have you noticed, that your mathematica code for expr is different from the code given in traditional form at the beginning. Your mathematica code has additional parenthes after the x in numerator, which changes everything! Commented Sep 1, 2020 at 7:05
• @Akku14Mathematica one is correct. Sorry for the typo/mistake. Commented Sep 1, 2020 at 14:27

Clear["Global*"]

expr = (c +
x (Log[-2 + 2 E^(c/x)] - Log[-1 + E^((2 c)/x)]))/(x (Log[-1 + E^(c/x)] -
Log[-1 + E^((2 c)/x)]));


Let z == c/x

expr2 = expr /. c -> x*z // Simplify

(* (z + Log[-2 + 2 E^z] - Log[-1 + E^(2 z)])/(Log[-1 + E^z] - Log[-1 + E^(2 z)]) *)


The exact minimum of expr2 with respect to z is expressed as Root expressions

min = Minimize[{expr2, z > 0}, z] // FullSimplify

(* {(Log[(1/2)*(1 + E^Root[
{Log[2^E^#1*(1 + E^#1)^(-1 - E^#1)] + E^#1*#1 & ,
1.2248036907419590925983044443814461790920.60205517313497}])] -
Root[{Log[2^E^#1*(1 + E^#1)^(-1 - E^#1)] + E^#1*#1 & ,
1.2248036907419590925983044443814461790920.60205517313497}])/
Log[1 + E^Root[{-((1 + E^#1)*Log[1 +
E^#1]) + E^#1*(Log[2] + #1) & ,
1.2248036907419590925983044443814461790920.60205517313497}]],
{z -> Root[{-((1 + E^#1)*Log[1 + E^#1]) + E^#1*(Log[2] + #1) & ,
1.2248036907419590925983044443814461790920.60205517313497}]}} *)


The approximate numeric values are

min // N

(* {-0.293815, {z -> 1.2248}} *)

argMin = z /. min[[2]];


Verifying,

D[expr2, z] == 0 /. z -> argMin // FullSimplify

(* True *)

D[expr2, {z, 2}] > 0 /. z -> argMin // Simplify

(* True *)


The minimum is along the line

c == x*argMin

(* c == x*Root[
{-((1 + E^#1)*Log[1 + E^#1]) + E^#1*(Log[2] + #1) & ,
1.2248036907419590925983044443814461790920.60205517313497}] *)

Show[
Plot3D[Evaluate@expr, {x, 0, 3}, {c, 0, 3*argMin},
PlotStyle -> Opacity[0.5],
PlotPoints -> 50,
WorkingPrecision -> 15],
Graphics3D[{Red, Thick,
Evaluate@Line[{{0, 0, min[[1]]}, {3, 3*argMin, min[[1]]}}]}],
AxesLabel -> (Style[#, 14, Bold] & /@ {x, c, "expr"}),
PlotLabel -> expr,
ImageSize -> Medium]