1
$\begingroup$

Before starting, FYI: This is a question related to 3D Plot the result of local Minimize with varying parameter values

Consider my objective function, $objF$:

objF=1/(2 s^2) (2 (-k + s) (d^2 - d s - ((d - s) ((-1 + d) k^2 r + c (2 d^2 (-1 + q) + k^2 (-1 + 2 q) r + 2 d s) - s (-2 (-1 + d) d + d s + s^2)) (-1 + t))/(2 s^2) - d t + s t) - (d^3 - 2 d^2 s + d s^2 - ((d - s)^2 (6 c d^2 (-1 + q) + 3 k^2 (-1 + d + c (-1 + 2 q)) r + 6 d (-1 + c + d) s - 4 d s^2 - 2 s^3) (-1 + t))/(6 s^2) - d^2 t + 2 d s t - s^2 t)/r)

with parameter values: $t=0.2$, $s=2$, $d=0.8$ and $k < d$, $k \geq 0$, $0 \leq r \leq 1$, $0 \leq c \leq 1$, and $q \geq 1$.

I'm trying to maximize the above objective function with respect to $r$ and $k$.

Eventually, I would like to Plot3D each of the optimal values of $objF$, $r$, and $k$ against $c$ and $q$.

My mathematica codes are as follows.

First, for $objF$:

max = MaxValue[{objF, k < d, k >= 0, 0 <= d <= 1, 2 d < s, 0 <= r <= 1, 0 <= t <= 1, 0 <= c <= 1, q >= 1}, {k, r}]
Plot3D[max, {c, 0, 1}, {q, 1, 2}, PlotRange -> All, AxesLabel -> {c, q, max}]

Second, for $r$:

maxR = Last@Last@Maximize[{objF, k < d, k >= 0, 0 <= d <= 1, 2 d < s, 0 <= r <= 1, 0 <= t <= 1, 0 <= c <= 1, q >= 1}, {k, r}]
Plot3D[r/.maxR, {c, 0, 1}, {q, 1, 2}, PlotRange -> All, AxesLabel -> {c, q, r}]

Third, for $k$:

maxK = First@Last@Maximize[{objF, k < d, k >= 0, 0 <= d <= 1, 2 d < s, 0 <= r <= 1, 0 <= t <= 1, 0 <= c <= 1, q >= 1}, {k, r}]
Plot3D[k/.maxK, {c, 0, 1}, {q, 1, 2}, PlotRange -> All, AxesLabel -> {c, q, k}]

These are not working properly. Can anyone help please? Thank you!

$\endgroup$
6
  • $\begingroup$ It is necessary to determine the parameters d, s, t at the beginning of the code. $\endgroup$ May 7, 2019 at 11:07
  • $\begingroup$ @Alex Trounev: I have corrected the silly mistake of forgetting to specify the value of t,s,d. Thanks for pointing this out! $\endgroup$
    – ppp
    May 7, 2019 at 13:06
  • $\begingroup$ There is $1/r$ and $r$ starts with r = 0. Therefore, with these parameters, the maximum=ComplexInfinity is reached at r = 0. $\endgroup$ May 7, 2019 at 21:17
  • $\begingroup$ @Alex Trounev: Thanks! My followup question is, how do we know that the numerator of the term with $\frac{1}{r}$ is positive? If it is negative, then the maximum is reached at r=1, no? $\endgroup$
    – ppp
    May 7, 2019 at 21:26
  • $\begingroup$ Yes, this is also possible, $r= 1$ included. But in 3D it looks awful. $\endgroup$ May 7, 2019 at 22:23

1 Answer 1

2
$\begingroup$

I use the numerical method, but because of the singularity $1/r$, I have to trim $r$, for example, start with $r=r0, r0=10^{-3}$. This value is selected to avoid messages.

Block[{d = .8, s = 2, t = .2, r0 = 10^-3}, 
 objF = 1/(2 s^2) (2 (-k + s) (d^2 - 
        d s - ((d - s) ((-1 + d) k^2 r + 
             c (2 d^2 (-1 + q) + k^2 (-1 + 2 q) r + 2 d s) - 
             s (-2 (-1 + d) d + d s + s^2)) (-1 + t))/(2 s^2) - d t + 
        s t) - (d^3 - 2 d^2 s + 
        d s^2 - ((d - s)^2 (6 c d^2 (-1 + q) + 
             3 k^2 (-1 + d + c (-1 + 2 q)) r + 6 d (-1 + c + d) s - 
             4 d s^2 - 2 s^3) (-1 + t))/(6 s^2) - d^2 t + 2 d s t - 
        s^2 t)/r); 
 max = Flatten[
   Table[{c, q, 
     MaxValue[{objF, 0 <= k < d, r0 <= r <= 1}, {k, r}]}, {c, 0, 
     1, .1}, {q, 1, 2, .1}], 1]; 
 maxk = Flatten[
   Table[{c, q, 
     k /. Last@
       Maximize[{objF, 0 <= k < d, r0 <= r <= 1}, {k, r}]}, {c, 0, 
     1, .1}, {q, 1, 2, .1}], 1]; 
 maxr = Flatten[
   Table[{c, q, 
     r /. Last@
       Maximize[{objF, 0 <= k < d, r0 <= r <= 1}, {k, r}]}, {c, 0, 
     1, .1}, {q, 1, 2, .1}], 1];]
{ListPlot3D[max, AxesLabel -> {"c", "q", "max"}], 
 ListPlot3D[maxk, AxesLabel -> {"c", "q", "maxK"}], 
 ListPlot3D[maxr, AxesLabel -> {"c", "q", "maxR"}]}

fig1

$\endgroup$
2
  • $\begingroup$ I have tried your solution with another objective function, which however generates some errors. I have create a new post for this question: mathematica.stackexchange.com/questions/200232/… Can you please help once more? $\endgroup$
    – ppp
    Jun 12, 2019 at 17:43
  • $\begingroup$ Hello Alex, I am applying your solution in an extended case where the objective function now takes three different expressions depending on the constraints. May I ask for your help once more? I really really appreciate! My new post is here: mathematica.stackexchange.com/questions/201823/… $\endgroup$
    – ppp
    Jul 9, 2019 at 21:21

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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