0
$\begingroup$

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?

$\endgroup$
2
$\begingroup$

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

enter image description here

NMaximize[{f[c], 1/7 <= c && c <= 1/5}, c, Method -> "DifferentialEvolution"]
(*{0.733816, {c -> 0.2}}*)
| improve this answer | |
$\endgroup$
  • $\begingroup$ 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)? $\endgroup$ – Penelope Benenati 2 days ago
  • 1
    $\begingroup$ @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}}. $\endgroup$ – user64494 2 days ago
  • 1
    $\begingroup$ @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}}}. $\endgroup$ – user64494 2 days ago
  • $\begingroup$ That's very useful! Thank you a lot! $\endgroup$ – Penelope Benenati 2 days ago

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.