# Nested optimization problem 2

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

f[w_, p_] := -p^2 + p w
g[w_] := w - pR[w]^2    (These functions are chosen to illustrate the problem, the real functions are more complicated and can only be solved numerically)

pR[w_] := NArgMax[{f[w, p], p > 0, w > 0}, p]
J[w_?NumericQ] := g[w]
NMaximize[{J[w], w > 0, f[w, pR[w]] > 0.5}, w,
Method -> "RandomSearch"]


If I would drop the condition f[w, pR[w]] > 0.5, the code works fine, but with this expression my code runs into problems with the constraints.

Any idea how to solve this?

Try

f[w_?NumericQ, p_?NumericQ] := -p^2 + p w

pR[w_?NumericQ] := Block[{p}, NArgMax[{f[w, p], p > 0}, p]]
J[w_?NumericQ] := w - pR[w]^2
NMaximize[{J[w], {w > 0 , f[w, pR[w]] > 0.5}}, w ,EvaluationMonitor :> Print[{w, J[w]}]
,Method->"NelderMeat", AccuracyGoal -> 3]
(*{1., {w -> 2.00012}}*)


It works with slow convergence in Mathematica v12...

• Thx Ulrich, the code converged at 2.0007 for me. However, i got the following errors : 1) NArgMax::bcons: The following constraints are not valid: {p>0,w>0}. Constraints should be equalities, inequalities, or domain specifications involving the variables. Nov 12 '19 at 14:46
• Try "NelderMeat" (see my edited answer). Mathematica v12(Windows 7) evaluates without error. Nov 12 '19 at 14:52
• I try the new method, thx Nov 12 '19 at 14:54
• Thx again, i am getting again closer. Nov 12 '19 at 17:35
• it would be amazing if you could have a look on the next problem I stumbled in :-( mathematica.stackexchange.com/questions/209492/… Nov 12 '19 at 17:48