3D plot of two spheres with constraint

I intended to plot two 3D volumes of two spheres, each centered around (x0,y0,z0)(x0,y0,z0)(x_0,y_0,z_0) and (x1,y1,z1)(x1,y1,z1)(x_1,y_1,z_1), respectively. Here the reference points must be selected as x0+y0+z0=1x_0+y_0+z_0=1 and x1+y1+z1=1x_1+y_1+z_1=1 and x1,x0,y1,y0,z1,z0>0x_1,x_0,y_1,y_0,z_1,z_0>0. For example x0=0.5x_0=0.5, y0=0.3y_0=0.3, z0=0.2z_0=0.2. The radiuses of each shperes must be selected such that the shperes dont overlap.

Then in the same plot I need to apply the constraint that the points must add upto 11, i.e. x+y+z=1x+y+z=1 and all these points (x,y,z)(x,y,z) must also be positive. This constraint will give triangle surfaces (if not volumes) in the spheres.

I want to use Opacity so that I can see both the spheres as well as the surfaces inside the spheres.

Lastly, an arrow from the center point of each sphere to its boundary labeled by ϵ0\epsilon_0 and ϵ1\epsilon_1.

I have an unsuccesful attempt as follows.

x0 = 0.5;
y0 = 0.3;
z0 = 0.2;
eps0 = .2;
mySphere = Graphics3D[{Opacity[0.5], Sphere[{x0, y0, z0}, .2]}, PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}}];
g1 = ContourPlot3D[x + y + z == 1, {x, 0, 1}, {y, 0, 1}, {z, 0, 1}, Mesh -> None]

x1 = 0.1;
y1 = 0.3;
z1 = 0.6;
eps1 = .3;

mySphere2 = Graphics3D[{Opacity[0.5], Sphere[{x1, y1, z1}, .3]}, PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}}];
Show[mySphere, g1, mySphere2, Axes -> True, AxesOrigin -> {0, 0, 0}, PlotRange -> {{-.5, 1}, {-.5, 1}, {-.5, 1}}, ViewPoint -> {1.55, -1.94, 2}]

After Updating the question with the given answer. What remains is that myplane is I think correct for g1 as above (the triangle) but it must be restricted to each sphere. Namely myplane1 needs to stay in the first sphere and myplane2 needs to stay in the second sphere. There musnt be any plane outside the shperes. One last thing, if it could be possible to put an arrow?

The problem is that RegionPlot3D is very ugly. I dont wanna mesh grids on the shpere and Opacity is of no help. Not the whole trianglelike surface must be plotted. Only the part which lies in the sphere.

Can you help me to do this?

=================

=================

2 Answers
2

=================

I think your question/request is:

Plot two non-intersecting semi-transparent spheres whose centers lie
on the plane P defined by x + y + z = 1, as well as P restricted to
the interiors of the spheres, all in the positive octant. Also add a labeled
arrow from the center to the surface of each sphere.

If so, here’s your solution:

center1 = {.5, .3, .2};
radius1 = .3;
center2 = {.1, .2, .7};
radius2 = .2;

mySphere1 =
Graphics3D[{Opacity[0.5], Sphere[center1, radius1]},
PlotRange -> {{-.2, 1}, {-.2, 1}, {-.2, 1}}];
mySphere2 =
Graphics3D[{Opacity[0.5], Sphere[center2, radius2]},
PlotRange -> {{-.2, 1}, {-.2, 1}, {-.2, 1}}];

myPlane =
Plot3D[1 – x – y, {x, 0, 1}, {y, 0, 1},
RegionFunction ->
Function[{x, y, z}, If[x > 0 \[And] y > 0 \[And] z > 0 \[And]
(Norm[{x, y, z} – center1] < radius1 \[Or] Norm[{x, y, z} - center2] < radius2), True, False]], Mesh -> None,
PlotStyle -> Opacity[0.9],
PlotRange -> {{-.2, 1.5}, {-.2, 1.5}, {-.2, 1.5}},
ClippingStyle -> None];

myArrow1 = Graphics3D[
{Red, Arrow[{center1, center1 + radius1 Normalize[{1, 1, 1}]}]}];
myArrow2 = Graphics3D[
{Red, Arrow[{center2, center2 + radius2 Normalize[{1, 1, 1}]}]}];

myLabel1 =
Graphics3D[
Text[Style[“\!\(\*SubscriptBox[\(\[Epsilon]\), \(1\)]\)”, 16, Red],
center1 + 1.2 radius1 Normalize[{1, 1, 1}] ]];
myLabel2 =
Graphics3D[
Text[Style[“\!\(\*SubscriptBox[\(\[Epsilon]\), \(2\)]\)”, 16, Red],
center2 + 1.3 radius2 Normalize[{1, 1, 1}] ]];

myfig = Show[mySphere1, mySphere2, myPlane, myArrow1, myArrow2,
myLabel1, myLabel2,
Axes -> True, AxesOrigin -> {0, 0, 0},
PlotRange -> {{-.2, 1}, {-.2, 1}, {-.2, 1}},
ViewPoint -> {2.8, -2.8, 2}]

  

 

I am sorry. My code is only for one sphere but what I need is two. Since at one I was away from what I needed to have, I didnt try more.
– Seyhmus Güngören
Jan 7 ’15 at 3:11

  

 

Okay I checked it. except for myplane everything is fine. myplane has the term 1-x-y and this becomes negative for some xx and yy. with the constraint, but for x+y+z=1x+y+z=1, we also need to have x>0x>0, y>0y>0 and z>0z>0. Mysphere is nice as I wanted. I worked out with your answer and I am updating the question now with only a few missing points.
– Seyhmus Güngören
Jan 7 ’15 at 3:45

  

 

Thank you very much for your help. It is very beautiful now. Only one more remaning point and the mission is completed. Just after the two arrow heads I would like to put ϵ0\epsilon_0 and ϵ1\epsilon_1, respectively. This is actually written in the question. On the other hand, I always accept the answers, pls have a look at my profile history. Thanks once again.
– Seyhmus Güngören
Jan 8 ’15 at 1:16

1

 

The placement of the label is a trivial modification of the code. I’ll do it, but you should be able to make such a trivial alteration on your own.
– David G. Stork
Jan 8 ’15 at 1:18

  

 

I did the labeling already for x,y,zx,y,z axes and also I changes a few more things. What remains is only those after the red arrows just after the heads of arrows.
– Seyhmus Güngören
Jan 8 ’15 at 1:20

Using

{c0, c1} = {{.5, .3, .2}, {.1, .2, .7}};
{r0, r1} = {.3, .2};
{l0, l1} = Style[Subscript[“\[Epsilon]”, #],Red,16] & /@ {“0”, “1”};
s = {{c0, r0, l0}, {c1, r1, l1}};

(a) You can use RegionFunction in your g1 to incorporate the constraints:

g1 = ContourPlot3D[x + y + z == 1, {x, 0, 1}, {y, 0, 1}, {z, 0, 1},
ContourStyle -> Directive[Opacity[.7], Orange], Mesh -> None,
RegionFunction -> Function[{x, y, z}, Or@@(Total[({x, y, z} – #)^2] <= #2^2 & @@@ s)]]; (b) You can have all your graphics primitives in a single Graphics3D: Graphics3D[{g1[[1]], {Opacity[.3], LightBlue, Sphere[#, #2], Opacity[1], Red, Arrow[{#, # + #2/Sqrt[3]}], Text[#3, 0.05 {1, 1, 1} + # + #2/Sqrt[3]]}&@@@ s}, PlotRange -> {{-.5, 1}, {-.5, 1}, {-.5, 1}}, ViewPoint -> {1.55, -1.94, 2}]

  

 

thank you very much for the answer. I just saw.
– Seyhmus Güngören
Jan 12 ’15 at 0:23

  

 

@Seyhmus, my pleasure..
– kglr
Jan 12 ’15 at 0:35