Nested optimization problem

Question

I would like to solve a maximization problem which itself depends on a maximization. I came up with this code,

pR[w_] := 
 Simplify[ ArgMax[{-p^2 + p w , p > 0, w > 0}, {p}] , w > 0] 
pR1[w_] := Part[pR[w], 1]
p2 = ArgMax[{ w - pR1[w]^2, 0 < w < 100}, {w}],

which works for analytically solveable functions. However, the functions in my real problem are not analytically sovelable, such that I tried something like

pR[w_] := 
 Simplify[NArgMax[{-p^2 + p w , p > 0, w > 0}, {p}, 
   Method -> "DifferentialEvolution"], w > 0]
pR1[w_] := Part[pR[w], 1]
p2[i_] = NMaximize[{ w - pR1[w], 0 < w < 100}, {w}, 
  Method -> "DifferentialEvolution"],

which does not return any results.

Do you have any idea how I get my code to work for only! numerically solutions, that is, how does the bottom code has to look like?

Thank you in advance Paul

Answer 1

Your second part NMaximize needs a functional with numerical arguments.

Try

pR[w_] := NArgMax[{-p^2 + p w, p > 0 }, p]  

J[w_?NumericQ] := w - pR[w]
NMaximize[{J[w], 0 <= w <= 100}, w  , Method -> "RandomSearch" ] 
(*{50., {w -> 100.}}*)

Don't know why the evaluation time is so long.

remark: Mathematica knows to solve minmax-problems