# Maximize an expression with respect to a variable after its minimization with respect to other variables

I started to use Mathematica a few time ago. I want to minimize the following expression (function of $$l,p,q,r,c$$) with respect to variables $$l, p, q, r$$ and then maximize the result obtained with respect to variable $$c$$. However, when I try to obtain an expression function of $$c$$ to maximize later using Minimize, I do not get any result because it takes too long. How can I solve this issue?

Minimize[{(((l^2/2)*(1-(1/4-c))+(l*p)*(1-1/4)+(l*q)*(1-(1/4+c))+(l*r)*(1-1/2)+(p^2/2)*(1-c)+(p*q)*(1-2*c)+(p*r)*(1-(1/4+c))+(q^2/2)*(1-c)+(q*r)*(1-1/4)+(r^2/2)*(1-(1/4-c)))/((l^2/2)*(1-(1/4-c))+(l*p)*(1-1/4)+(l*q)*(1-(1/4-c))+(l*r)*(1-0)+(p^2/2)*(1-c)+(p*q)*(1-(1/4-c))+(p*r)*(1-0)+(q^2/2)*(1-(1/4-c))+(q*r)*(1-1/4)+(r^2/2)*(1-0))), l >= 1, p >= 0, q >= 0, r >= 0, l + p + q + r == 1000000, 1/7<c<1/5}, {l, p, q, r}]


Why does the above command never end?

This can be done numerically (only numerically in my opinion) in a standard way which takes a lot of time:

f[c_?NumericQ] := NMinimize[{(((l^2/2)*(1 - (1/4 - c)) + (l*p)*(1 - 1/4) + (l*
q)*(1 - (1/4 + c)) + (l*r)*(1 - 1/2) + (p^2/2)*(1 -
c) + (p*q)*(1 - 2*c) + (p*r)*(1 - (1/4 + c)) + (q^2/2)*(1 -
c) + (q*r)*(1 - 1/4) + (r^2/2)*(1 - (1/4 - c)))/((l^2/
2)*(1 - (1/4 - c)) + (l*p)*(1 - 1/4) + (l*
q)*(1 - (1/4 - c)) + (l*r)*(1 - 0) + (p^2/2)*(1 - c) + (p*
q)*(1 - (1/4 - c)) + (p*r)*(1 - 0) + (q^2/
2)*(1 - (1/4 - c)) + (q*r)*(1 - 1/4) + (r^2/2)*(1 - 0))),
l >= 1, p >= 0, q >= 0, r >= 0, l + p + q + r == 1000000
}, {l, p, q, r}, Method -> "DifferentialEvolution"][[1]]
f[0.196]
(*0.732468*)
Plot[f[c], {c, 0.19, 0.20}]


NMaximize[{f[c], 1/7 <= c && c <= 1/5}, c, Method -> "DifferentialEvolution"]
(*{0.733816, {c -> 0.2}}*)

• Thank you a lot! This is really helpful! I also wanted to find the maximum where $c\in[1/8,1/4]$, but it seems that it never ends. How long should it take in your opinion (working online)? – Penelope Benenati Sep 17 '20 at 12:27
• @PenelopeBenenati: A fast approach n = 20; Table[f[1/8 + i/8/n], {i, 0, n}] // AbsoluteTiming results in {35.0773, {0.707272, 0.709595, 0.711898, 0.714179, 0.716439, 0.71868, 0.7209, 0.7231, 0.725283, 0.727443, 0.729585, 0.73171, 0.733816, 0.73141, 0.721986, 0.712454, 0.702283, 0.691479, 0.680106, 0.668219, 0.655869}}. – user64494 Sep 17 '20 at 15:31
• @PenelopeBenenati: The long approach NMaximize[{f[c], 1/8 <= c && c <= 1/4}, c, Method -> "DifferentialEvolution"] // AbsoluteTiming results in {5589.06, {0.738147, {c -> 0.201805}}}. – user64494 Sep 17 '20 at 16:36
• That's very useful! Thank you a lot! – Penelope Benenati Sep 17 '20 at 16:41