2
$\begingroup$

I rarely use Mathematica, but I usually do not have any problem with simple commands like Minimize or Maximize. I have find to maximum over $0<a\le\tfrac14$ of the minimum over $c<p\le\tfrac12$ for some very small positive constant $c$ of the following expression:

$$\frac{p \log\frac{p}{p+a}+(1-p) \log\frac{1-p}{1-(p+a)}}{a^2}\,.$$

Hence, I tried to use Maximize[{Minimize[{(p Log[(p/(p+a))]+(1-p) Log[((1-p)/(1-(p+a)))])/a^2, 0<a<=1/4 && 1/100<p<=1/2},{p}], 0<a<=1/4 && 1/100<p<=1/2}, {a}], but I do not any result at all.

Could you please explain the reason of the missing output?

$\endgroup$

2 Answers 2

1
$\begingroup$

In 13.3 on Windows 10 using a fresh kernel,

f[a_?NumericQ] := NMinimize[{(p Log[(p/(p + a))] + (1 - 
      p) Log[((1 - p)/(1 - (p + a)))])/a^2, 1/100 < p <= 1/2}, p] 
f[0.1]

{2.00447, {p -> 0.433393}}

NMaximize[{f[a]//First, a > 0 && a <= 1/4}, a]

{2.02875, {a -> 0.25}}

f[0.25]

{2.02875, {p -> 0.334294}}

$\endgroup$
5
$\begingroup$

There doesn't seem to be a closed-form symbolic solution for

Minimize[{(p Log[(p/(p + a))] + (1 - p) Log[((1 - p)/(1 - (p + a)))])/a^2, 0 < p < 1/2}, p]

So creating a table of minimum values for values of a might shed some insight.

t = Table[Flatten[{a, 
  FindMinimum[{(p Log[(p/(p + a))] + (1 - p) Log[((1 - p)/(1 - (p + a)))])/a^2, 0 < p < 1/2},
  {p, 0.4}]}], {a, 1/1000, 1/4, 1/1000}];
ListPlot[t[[All, {1, 2}]], Frame -> True, 
  FrameLabel -> (Style[#, Bold, 18, Black] &) /@ {"a", ""}]

enter image description here

So it looks like the maximum of the minimums is achieved when $ a=1/4$. That happens to correspond to the last value in the table t:

t[[250]]
(* {1/4, 2.02875, p -> 0.334294} *)
$\endgroup$
5
  • $\begingroup$ How can we know that there are no pairs $(a,p)$ corresponding to a smaller than $2$ for the evaluated function? $\endgroup$ Aug 20, 2023 at 17:35
  • $\begingroup$ There is something I do not understand: if $p$ is set to be equal to $0.334294$ then the maximum of the resulting (monotonically decreasing) function is attained when $a\to 0$, giving a limit value equal to $\frac{1}{2p-2p^2}$, right? This value is higher than $2.02875$. $\endgroup$ Aug 20, 2023 at 17:40
  • 1
    $\begingroup$ A contour plot with the table of minimum values of $p$ for a given $a$ might be convincing: t=Table[Flatten[{a,p/. FindMinimum[{(p Log[(p/(p + a))]+(1-p) Log[((1-p)/(1 -(p+a)))])/a^2,0<p<1/2}, {p,0.4}][[2]]}], {a,1/1000,1/4,1/1000}];Show[ContourPlot[(p Log[(p/(p+a))]+(1-p) Log[((1-p)/(1-(p+a)))])/a^2, {a,0,1/4}, {p,1/100,1/2}, Contours -> {2.05, 2.1, 2.15, 2.2, 2.01, 2.02, 2.03, 2.04}, ContourShading -> None, FrameLabel -> (Style[#, Bold, 18] &) /@ {"a", "p"}], ListPlot[t, Joined -> True, PlotStyle -> Red], ListPlot[{{1/4, 0.334294}}, PlotStyle -> {{Red, PointSize[0.02]}}]] . $\endgroup$
    – JimB
    Aug 20, 2023 at 18:00
  • $\begingroup$ Thank you JimB ! $\endgroup$ Aug 21, 2023 at 9:32
  • 1
    $\begingroup$ Feel free to un-accept this somewhat roundabout answer for another that's more direct. $\endgroup$
    – JimB
    Aug 21, 2023 at 18:07

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.