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$

1 Answer 1

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}}*)
$\endgroup$
4
  • $\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$ Sep 17, 2020 at 12:27
  • 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
    Sep 17, 2020 at 15:31
  • 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
    Sep 17, 2020 at 16:36
  • $\begingroup$ That's very useful! Thank you a lot! $\endgroup$ Sep 17, 2020 at 16:41

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.