2
$\begingroup$

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: enter image description here 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.

$\endgroup$
2
  • $\begingroup$ 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! $\endgroup$
    – Akku14
    Commented Sep 1, 2020 at 7:05
  • $\begingroup$ @Akku14Mathematica one is correct. Sorry for the typo/mistake. $\endgroup$ Commented Sep 1, 2020 at 14:27

1 Answer 1

5
$\begingroup$
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]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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