Analytical value of minima of a function involving Logarithm and exponential

Question

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.

Bob Hanlon · Accepted Answer

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.22480369074195909259830444438144617909`20.60205517313497}])] - 
        Root[{Log[2^E^#1*(1 + E^#1)^(-1 - E^#1)] + E^#1*#1 & , 
      1.22480369074195909259830444438144617909`20.60205517313497}])/
     Log[1 + E^Root[{-((1 + E^#1)*Log[1 + 
                          E^#1]) + E^#1*(Log[2] + #1) & , 
       1.22480369074195909259830444438144617909`20.60205517313497}]], 
   {z -> Root[{-((1 + E^#1)*Log[1 + E^#1]) + E^#1*(Log[2] + #1) & , 
     1.22480369074195909259830444438144617909`20.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.22480369074195909259830444438144617909`20.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]

Analytical value of minima of a function involving Logarithm and exponential

One Answer

Add your own answers!

Ask a Question