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$
  • $\begingroup$ It is necessary to determine the parameters d, s, t at the beginning of the code. $\endgroup$ – Alex Trounev May 7 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 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$ – Alex Trounev May 7 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 at 21:26
  • $\begingroup$ Yes, this is also possible, $r= 1$ included. But in 3D it looks awful. $\endgroup$ – Alex Trounev May 7 at 22:23
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$
  • $\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 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 at 21:21

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.