3
$\begingroup$

I am trying to visualize a condition with the function RegionPlot3D. I know that the area should look like this: Ideally That is, for every v there is some orange area.

However, some areas are too thin, so mathematica has not shown them and showed this instead: reality Is there a way I can make mathematica show all conditions (like the first image)? Thank you!

RegionPlot3D[(-a^2 + 2 a c + a^2 c - c^2 - c^3)/(a c - c^2 - c^3) > v > 1/Root[
 a^2 - a c - a^2 c + 2 a c^2 - 
   c^3 + (-a^2 + a^3 + a c + 3 a^2 c - a^3 c - 5 a c^2 + 
      2 c^3) #1 + (2 a^3 - 5 a^2 c - a^3 c + 4 a c^2 + 2 a^2 c^2 -
       c^3 - a c^3) #1^2 + (-a^3 + 2 a^2 c + a^3 c - a c^2 - 
      2 a^2 c^2 + a c^3) #1^3 &, 3] && 1 > c > a > 0, {v, .001,1}, {c, .001, .999}, {a, .001, .999}]
Improve this question
$\endgroup$
3
  • $\begingroup$ Please include Mathematica code for a minimal example that would replicate the plot shown in the OP. Thanks. $\endgroup$ Commented Nov 5, 2024 at 15:00
  • $\begingroup$ @Syed Edited. Thank you for reminding! $\endgroup$ Commented Nov 5, 2024 at 15:08
  • $\begingroup$ NIntegrate[ Boole[(-a^2 + 2 a c + a^2 c - c^2 - c^3)/(a c - c^2 - c^3) > v > 1/Root[a^2 - a c - a^2 c + 2 a c^2 - c^3 + (-a^2 + a^3 + a c + 3 a^2 c - a^3 c - 5 a c^2 + 2 c^3) #1 + (2 a^3 - 5 a^2 c - a^3 c + 4 a c^2 + 2 a^2 c^2 - c^3 - a c^3) #1^2 + (-a^3 + 2 a^2 c + a^3 c - a c^2 - 2 a^2 c^2 + a c^3) #1^3 &, 3] && 1 > c > a > 0 && a >= 0], {a, 0, 1}, {c, 0, 1}, {v, 0, 1}, AccuracyGoal -> 6, PrecisionGoal -> 6, Method -> "LocalAdaptive"] results in 0.0662847, confirming the set under cosideration is a solid. $\endgroup$ Commented Nov 7, 2024 at 12:24

2 Answers 2

Reset to default
3
$\begingroup$

As usually, WorkingPrecision -> 12, PlotPoints -> 75 help.

RegionPlot3D[(-a^2 + 2 a c + a^2 c - c^2 - c^3)/(a c - c^2 - c^3) > 
   v > 1/Root[ a^2 - a c - a^2 c + 2 a c^2 - 
   c^3 + (-a^2 + a^3 + a c + 3 a^2 c - a^3 c - 5 a c^2 + 
      2 c^3) #1 + (2 a^3 - 5 a^2 c - a^3 c + 4 a c^2 + 2 a^2 c^2 -
       c^3 - a c^3) #1^2 + (-a^3 + 2 a^2 c + a^3 c - a c^2 - 
      2 a^2 c^2 + a c^3) #1^3 &, 3] && 1 > c > a > 0, {v, .001,1}, 
{c, .001, .999}, {a, .001, .999}, WorkingPrecision -> 12,  PlotPoints -> 75]

enter image description here

and a several warnings caused by that Root[] involves complex numbers.

Improve this answer
$\endgroup$
1
  • $\begingroup$ @The downvoter: What is incorrect in my answer? It is unfair to down vote without any explaining comment. $\endgroup$ Commented Nov 7, 2024 at 11:42
7
$\begingroup$

A better equality plots.

Expression for eq and r are taken from OP code and then they are used to make equations in a slightly different form. The equations are used in ContourPlot3D instead of RegionPlot3D used in OP.

eq = v == (-a^2 + 2 a c + a^2 c - c^2 - c^3)/(a c - c^2 - c^3);

r = Root[a^2 - a c - a^2 c + 2 a c^2 - 
     c^3 + (-a^2 + a^3 + a c + 3 a^2 c - a^3 c - 5 a c^2 + 
        2 c^3) #1 + (2 a^3 - 5 a^2 c - a^3 c + 4 a c^2 + 2 a^2 c^2 - 
        c^3 - a c^3) #1^2 + (-a^3 + 2 a^2 c + a^3 c - a c^2 - 
        2 a^2 c^2 + a c^3) #1^3 &, 3];

nr = Root[r[[1]]@(1/x) // Factor // Numerator, x, 2];

eq1 = a == 
   SolveValues[
     v == (-a^2 + 2 a c + a^2 c - c^2 - c^3)/(a c - c^2 - c^3), 
     a][[2]];
eq2 = v == nr;

ContourPlot3D[Evaluate@eq1, {v, 0, 1}, {c, 0, 1}, {a, 0, 1}]
ContourPlot3D[Evaluate@eq2, {v, 0, 1}, {c, 0, 1}, {a, 0, 1}]
Show[%%, %]

enter image description here

Update:

@C.K wanted to see the thickness of the region (see his comment).

The thickness is depicted by slicing the region with planes c=1, c=0.9, ... c=0 for step s=0.1.

The first image is for s=1/10, the second image for s=1/100.

In the code we have to take care of special limit case c=1 - hence the Which and special limit case c=0 - hence the Append.

s = 1/10;
plots = Append[
   Table[ContourPlot[
     Which[c == 1, {v == (2 - 2 a)/(2 - a), v == 1 - a}, 
       True, {v == (
         a^2 - 2 a c - a^2 c + c^2 + c^3)/(-a c + c^2 + c^3), 
        v == Root[
          a^3 - 2 a^2 c - a^3 c + a c^2 + 2 a^2 c^2 - 
            a c^3 + (-2 a^3 + 5 a^2 c + a^3 c - 4 a c^2 - 2 a^2 c^2 + 
               c^3 + a c^3) #1 + (a^2 - a^3 - a c - 3 a^2 c + a^3 c + 
               5 a c^2 - 2 c^3) #1^2 + (-a^2 + a c + a^2 c - 2 a c^2 +
                c^3) #1^3 &, 2]}] // Evaluate, {v, 0, 1}, {a, 0, c}, 
     ContourStyle -> Blend[ColorData[97] /@ {1, 4}, c], 
     PlotPoints -> 50], {c, 1, s, -s}], 
   ContourPlot[a == 0, {v, 0, 1}, {a, -0.01, 1}, 
    ContourStyle -> Blend[ColorData[97] /@ {1, 4}, 0], 
    PlotPoints -> 50]];

Show@plots

Manipulate[
 Show[plots[[n]], PlotRange -> {0, 1}], {n, 1, Length[plots], 1}]

enter image description here

enter image description here

Improve this answer
$\endgroup$
10
  • $\begingroup$ The results of NIntegrate[ Boole[(-a^2 + 2 a c + a^2 c - c^2 - c^3)/(a c - c^2 - c^3) > v > 1/Root[a^2 - a c - a^2 c + 2 a c^2 - c^3 + (-a^2 + a^3 + a c + 3 a^2 c - a^3 c - 5 a c^2 + 2 c^3) #1 + (2 a^3 - 5 a^2 c - a^3 c + 4 a c^2 + 2 a^2 c^2 - c^3 - a c^3) #1^2 + (-a^3 + 2 a^2 c + a^3 c - a c^2 - 2 a^2 c^2 + a c^3) #1^3 &, 3] && 1 > c > a > 0 && a >= 0], {a, 0, 1}, {c, 0, 1}, {v, 0, 1}, AccuracyGoal -> 4, PrecisionGoal -> 4, Method -> "LocalAdaptive"] is 0.066437. This shows the set under consideration is a solid., not a surface. $\endgroup$ Commented Nov 7, 2024 at 11:16
  • $\begingroup$ We see inequalities in (-a^2 + 2 a c + a^2 c - c^2 - c^3)/(a c - c^2 - c^3) > v > 1/Root[ a^2 - a c - a^2 c + 2 a c^2 - c^3 + (-a^2 + a^3 + a c + 3 a^2 c - a^3 c - 5 a c^2 + 2 c^3) #1 + (2 a^3 - 5 a^2 c - a^3 c + 4 a c^2 + 2 a^2 c^2 - c^3 - a c^3) #1^2 + (-a^3 + 2 a^2 c + a^3 c - a c^2 - 2 a^2 c^2 + a c^3) #1^3 &, 3] && 1 > c > a > 0. $\endgroup$ Commented Nov 7, 2024 at 11:19
  • $\begingroup$ In view of the above is your result not a fake? $\endgroup$ Commented Nov 7, 2024 at 11:20
  • 1
    $\begingroup$ @user64494 Question is about depicting the object not about any integral. 3D objects are perfectly well depicted by boundary surfaces by which they are enclosed. $\endgroup$ Commented Nov 7, 2024 at 13:32
  • 1
    $\begingroup$ @C.K Search the documentation for commands you do not understand. It is explained in the answer what the output represents. $\endgroup$ Commented Nov 13, 2024 at 21:35

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.