Minimax problem where a combination of Minimize and Maximize gives no result at all

Question

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?

Answer 1

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

Answer 2

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

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} *)