Message Boards Message Boards

0
|
4864 Views
|
1 Reply
|
0 Total Likes
View groups...
Share
Share this post:

3D Plot a maximization of a definite integral

Posted 5 years ago

My Mathematica code ran forever; it took me the whole day and finally returned 'Why the Beep?' message saying: "There appears to be an error in the file named below. You should close it without saving, then check the "Parse and load entire notebook into memory upon opening" checkbox in the Notebook Options dialog. File name: ...."

What I'm trying to do is to 3D plot a maximization result of an definite integral under some constraints on the parameter values. Let me reproduce my code:

s = 2; d = 4/5; t = 0;
J= -((-(64/25) + 8/5 k (-1 + r) + k (k + 4 r + k (-3 + r) r))/(40 (-1 + r))) + c (((-1 + q) (16/25 (1 - 2 r) + (8 k r^2)/5 + k^2 r (1 + (-3 + r) r)))/(4 (-1 + r)^2) + (-(64/25) + 8/5 k (-1 + r) + k (k + 4 r + k (-3 + r) r))/(8 (-1 + r)))
AA = (((1 - r)*x + r*y - J)*(1 - t) - (d - t))/s^2; 
BB = (((1 - r)*x + r*k - J)*(1 - t) - (d - t))/s^2; 
CC = (((1 - r)*x + r*(x - k) + r*y - J)*(1 - t) - (d - t))/s^2; 
DD = (((1 - r)*x + r*(x - k) + r*k - J)*(1 - t) - (d - t))/s^2; 
EE = (((1 - r)*x + r*(x - k) + r*y - J)*(1 - t) - (d - t))/s^2; 
FF = (((1 - r)*x + r*(x - k) + r*k - J)*(1 - t) - (d - t))/s^2;
regAA = ImplicitRegion[AA > 0 && (d - r*k)/(1 - r) <= x <= k && (d + r*x - x)/r <= y <= k, {x, y}];
regBB = ImplicitRegion[BB > 0 && (d - r*k)/(1 - r) <= x <= k && k <= y <= s, {x, y}]; 
regCC = ImplicitRegion[CC > 0 && k <= x <= d + r*k && (d + r*k - x)/r <= y <= k, {x, y}];
regDD = ImplicitRegion[DD > 0 && k <= x <= d + r*k && k <= y <= s, {x, y}];
regEE = ImplicitRegion[EE > 0 && d + r*k <= x <= s && 0 <= y <= k, {x, y}];
regFF = ImplicitRegion[FF > 0 && d + r*k <= x <= s && k <= y <= s, {x, y}];
f2 = Integrate[AA, {x, y} \[Element] regAA] + Integrate[BB, {x, y} \[Element] regBB] + Integrate[CC, {x, y} \[Element] regCC] + Integrate[DD, {x, y} \[Element] regDD] + Integrate[EE, {x, y} \[Element] regEE] + Integrate[FF, {x, y} \[Element] regFF];
max2 = Flatten[ Table[{c, q, MaxValue[{f2, 0 <= c <= 1, 1 <= q <= 2, c*q <= 1, d <= k <= 2, 0 <= r*k < d}, {k, r}]}, {c, 0, 1, .1}, {q, 1, 2, .1}], 1]; 
maxk2 = Flatten[Table[{c, q, k /. Last@Maximize[{f2, 0 <= c <= 1, 1 <= q <= 2, c*q <= 1, d <= k <= 2, 0 <= r*k < d}, {k, r}]}, {c, 0, 1, .1}, {q, 1, 2, .1}], 1];
maxr2 = Flatten[Table[{c, q, r /. Last@Maximize[{f2, 0 <= c <= 1, 1 <= q <= 2, c*q <= 1, d <= k <= 2, 0 <= r*k < d}, {k, r}]}, {c, 0, 1, .1}, {q, 1, 2, .1}], 1];
{ListPlot3D[max2, AxesLabel -> {"c", "q", "f"}], ListPlot3D[maxk2, PlotRange -> {0, 2}, AxesLabel -> {"c", "q", "k"}], ListPlot3D[maxr2, PlotRange -> {0, 1}, AxesLabel -> {"c", "q", "r"}]}

Can anyone help in figuring out any error in the code?

Edit: I am attaching my Notebook file which will be helpful in understanding what I'm doing.

Attachments:
POSTED BY: Ian P
Posted 5 years ago

Crossposted here.

POSTED BY: Rohit Namjoshi
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract