# How to remove unwanted regions in a three-dimensional surface

As the title indicates, I want to delete some unwanted regions in a three-dimensional surface created using ContourPlot3D. Here is the corresponding code

Clear["Global*"];

V = 1/2*(x^2 + y^2 + z^2) + (x^2*y^2 + x^2*z^2 + y^2*z^2 - x^2*y^2*z^2);

E0 = 7;

S0 = ContourPlot3D[V == E0, {x, -4, 4}, {y, -4, 4}, {z, -4, 4},
PlotPoints -> 70, PerformanceGoal -> "Speed", Mesh -> None,
ContourStyle -> Directive[Green, Opacity[0.3], Specularity[White, 30]],
ImageSize -> 550]


which produces this output: I want somehow to keep the inside closed 3D surface (which looks like a 3D star) and delete the eight open parts which surround it. I tried several combinations using RegionPlot3D but the particular range of $x$, $y$ and $z$ prevent me from obtaining what I want. Any suggestions?

EDIT

If you increase the value of E0 then after a certain value the three-dimensional surface opens and eight channels of escapes (holes) appear. Using this code

Clear["Global*"];

V = 1/2*(x^2 + y^2 + z^2) + (x^2*y^2 + x^2*z^2 + y^2*z^2 - x^2*y^2*z^2);

E0 = 8.5;
R0 = 6;

S0 = ContourPlot3D[V == E0, {x, -5, 5}, {y, -5, 5}, {z, -5, 5},
PlotPoints -> 100, PerformanceGoal -> "Speed", Mesh -> None,
ContourStyle -> Directive[Green, Opacity[0.3], Specularity[White, 30]],
ImageSize -> 550, RegionFunction -> Function[{x, y, z}, Sqrt@(x^2*y^2 +
x^2*z^2 + y^2*z^2) <= R0]]


you get this output OK, my question is the following: How can I draw the surface and manipulate the openings at the minimum width. Let me be more specific. Now, using the current code the size of the openings is controlled by the cutoff surface and the particular value of $R0$. If for example, I use $R0 = 2.5$ then I loose essential parts of the surface. What I want is to define such a cutoff surface or find the specific value of $R0$ so that the external cutoff surface to abut exactly against the inner surface thus, drawing the openings at their minimum width.

Any suggestions?

Βαγγέλη, you can use an appropriate RegionFunction:

V = 1/2*(x^2 + y^2 + z^2) + (x^2*y^2 + x^2*z^2 + y^2*z^2 -
x^2*y^2*z^2);

E0 = 7;

S0 = ContourPlot3D[V == E0, {x, -4, 4}, {y, -4, 4}, {z, -4, 4},
PlotPoints -> 70, PerformanceGoal -> "Speed", Mesh -> None,
ContourStyle ->
Directive[Green, Opacity[0.3], Specularity[White, 30]],
ImageSize -> 550,
RegionFunction ->
Function[{x, y, z}, 3 - Sqrt[x^2*y^2 + y^2 z^2] > 0]] ---EDIT---

RegionFunction works like a cutoff. You need to find the equation of a curve that splits your wanted from your unwanted parts. Here

cutoff =
ContourPlot3D[
Sqrt[x^2*y^2 + y^2 z^2] == 3, {x, -4, 4}, {y, -4, 4}, {z, -4, 4}];
Show[S0, cutoff] But how you'd guess it is a different issue. Normally manipulate your original surface. I.e. note that

cutoff2 =
ContourPlot3D[
Sqrt@(x^2*y^2 + x^2*z^2 + y^2*z^2) == 4, {x, -4, 4}, {y, -4,
4}, {z, -4, 4}, ContourStyle -> Opacity[0.4], Mesh -> None];
Show[S0, cutoff2] also works (in fact is a more obvious choice).

---2nd EDIT---

If you want to qualitatively see whether the containment of the surface is satisfactory, leave your R0 variable and wrap a low-res version within a manipulate to see which value you like.

Manipulate[
TableForm@{ContourPlot3D[
V == E0, {x, -5, 5}, {y, -5, 5}, {z, -5, 5},
PerformanceGoal -> "Speed",
Mesh -> None,
PlotPoints -> 40,
ContourStyle ->
Directive[Green, Opacity[0.3], Specularity[White, 30]],
ImageSize -> 550,
RegionFunction ->
Function[{x, y, z}, Sqrt@(x^2*y^2 + x^2*z^2 + y^2*z^2) <= R0]],
R0}, {R0, 2, 6, 0.1}] If you want to find the actual minimum, you'd have to find an expression for the intersection of the two surfaces, parametrise it, and minimize its length.

• Great! Could you explain a little bit how this particular RegionFunction come from? I mean which theory is behind it. Mar 27 '13 at 8:45
• When $V$ has another mathematical expression then the appropriate RegionFunction changes. However, I cannot understand how the function $3 - \sqrt{x^2 y^2 + y^2 z^2} > 0$ come from. It is essential to me to know how to obtain this function every time. So, please enlighten me a little bit! Mar 27 '13 at 9:05
• @Vaggelis_Z If you have a surface like yours that is a generalised "sphere" in that you can permute any two cartesian coordinates and get the same expression, you need to define your cutoff as something with larger radius or slightly deformed. Does that help?
– gpap
Mar 27 '13 at 9:34
• Yes indeed, now everything is very clear. Thank you very much! Mar 27 '13 at 9:38
• Any ideas about my EDIT? Many thanks in advance! Mar 28 '13 at 10:34

By looking at the hyperbolic behavior of the branches, you may try a simple RegionFunction[]:

ContourPlot3D[V == E0, {x, -4, 4}, {y, -4, 4}, {z, -4, 4},
PlotPoints -> 70, PerformanceGoal -> "Speed", Mesh -> None,
ContourStyle -> Directive[Green, Opacity[0.3], Specularity[White, 30]], ImageSize -> 550,
RegionFunction -> (Abs[#1 #2 #3] < 3 &)] Edit

Just checking the whole solid is included

Show[ContourPlot3D[V == E0, {x, -4, 4}, {y, -4, 4}, {z, -4, 4},
PlotPoints -> 70, PerformanceGoal -> "Speed", Mesh -> None,
ContourStyle -> Directive[Green, Opacity[0.3], Specularity[White, 30]],
ImageSize -> 550, RegionFunction -> (Abs[Times[#1 #2 #3]] < 3 &)],
ParametricPlot3D[{x, y, Abs[3/(x y)]}, {x, 0, 4}, {y, -4, 4},
PlotPoints -> 70, PerformanceGoal -> "Speed", Mesh -> None,
PlotRange -> {-5, 5}]] For giggles, here's a variation of belisarius's answer:

ContourPlot3D[V == E0, {x, -4, 4}, {y, -4, 4}, {z, -4, 4},
ContourStyle -> Directive[Opacity[0.3, Green], Specularity[1, 30]],
Mesh -> None, PerformanceGoal -> "Speed", PlotPoints -> 70,
RegionFunction -> Function[{x, y, z}, Evaluate[
PolyhedronData["Octahedron", "RegionFunction"][Sqrt x/9, Sqrt y/9, Sqrt z/9]]]]