3D Plot maximization results with varying parameter values

Question

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

$objF = \frac{d^3+3 d^2 (k (r-1)-s)+3 d \left(k^2 ((r-3) r+1)+2 k r s-2 (r-1) s^2\right)+k^3 (r ((r-1) r+3)-1)-3 k^2 r^2 s+3 (r-1) s^3}{6 (r-1) s^2}$

under the conditions of $0\leq d\leq 1$, $s\geq 2 d$, $d\leq k\leq s$, and $0\leq r<\frac{d}{k}$. And plot the maximum of the objective function, $r^*$, and $k^*$ against the varying parameter values of $d \in [0,1]$ and $s\in [0,2]$.

My Mathematica code is:

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

And I got the following result.

I have two issues (or questions) with this result.

First, I'm curious what the gray areas in the last diagram mean.

Second, in order to check the concrete value of the objective function with specific parameter values, e.g., $s=1.8$ and $d=0.7$, I used the following code:

Block[{s = 1.8, d = 0.7}, objF = 1/( 6 (-1 + r) s^2) (d^3 + k^3 (-1 + r (3 + (-1 + r) r)) + 3 d^2 (k (-1 + r) - s) - 3 k^2 r^2 s + 3 (-1 + r) s^3 + 3 d (k^2 (1 + (-3 + r) r) + 2 k r s - 2 (-1 + r) s^2)); max = MaxValue[{objF, d <= k <= s, 0 <= r < d/k}, {k, r}]; maxk = k /. Last@Maximize[{objF, d <= k <= s, 0 <= r < d/k}, {k, r}]; maxr = r /. Last@Maximize[{objF, d <= k <= s, 0 <= r < d/k}, {k, r}]] {max, maxk, maxr}

And the result is:

That is, the maximum $objF=0$, $k^* =0$, and $r^* =0$. This result is very strange since a quick inspection of the above diagrams show that at $s=1.8$ and $d=0.7$, we have both the maximum $objF$ and $k^*$ positive.

Answer 1

The answer of your first question is quite easy: You try to plot a value which is near zero and cut the negativ part (PlotRange).

I'm wondering why you didn't use NMaximize? Here my approach(firstly without restriction 0<d<1, d <= s/2)

max[d_?NumericQ, s_?NumericQ] := {d, s,NMaximize[{1/(6 (-1 + r) s^2) (d^3 +k^3 (-1 + r (3 + (-1 + r) r)) + 3 d^2 (k (-1 + r) - s) - 3 k^2 r^2 s + 3 (-1 + r) s^3 + 3 d (k^2 (1+ (-3 + r) r) + 2 k r s - 2 (-1 + r) s^2)), 
d <= k <= s, 0 <= r k < d}, {k, r}]}

That's it.

Plot the results (requires some time...)

ListPlot3D[DeleteCases[Table[{d, s, r /. max[d, s][[3, 2]]}, {d, 0.05, 1, .05}, {s, 2 d, 1, .05}], {}] // Flatten[#, 1] &, PlotRange -> All, AxesLabel -> {d, s, r}]

ListPlot3D[DeleteCases[Table[{d, s, k /. max[d, s][[3, 2]]}, {d, 0.05, 1, .05}, {s, 2 d, 1, .05}], {}] // Flatten[#, 1] &, AxesLabel -> {d, s, k}]

ListPlot3D[DeleteCases[Table[{d, s, max[d, s][[3, 1]]}, {d, 0.05, 1, .05}, {s, 2 d, 1, .05}], {}] // Flatten[#, 1] &, AxesLabel -> {d, s, max}]