# Select spheres intersecting with big sphere from list

The following code gives me a red sphere, whose surface intersects with a list of some smaller spheres:

list = Tuples[Table[i, {i, -2, 2}], 3];

Graphics3D[{Sphere[{#}, 0.1] & /@ {list}, Style[Sphere[{0, 0, 0}, 3], Opacity[0.4], Red]}] How can I select only those tuples (smaller spheres) from list that have an intersection with the surface of red sphere?

list = Tuples[Table[i, {i, -2, 2}], 3];
smallspheres = Sphere[#, 1/10] & /@ list;
bigsphere = Sphere[{0, 0, 0}, 3];
MemberBigSphereQ = RegionIntersection[bigsphere, #] =!= EmptyRegion &
surfacespheres = Select[smallspheres, MemberBigSphereQ]

Graphics3D[Join[{bigsphere}, surfacespheres]] By packing the spheres more densely it gets more interesting :)

list = Tuples[Table[i, {i, -3, 3, 1/5}], 3];
smallspheres = Sphere[#, 1/10] & /@ list;
surfacespheres = Select[smallspheres, MemberBigSphereQ]
Graphics3D[Join[surfacespheres, {Red, Opacity[0.4], bigsphere}]] • This solution is mainly for showing how this problem can be solved neatly in an idiomatic way in Mathematica, which i think is good to pick up some high level programming concepts in Mathematica. This makes for good readability and generality and works sufficiently well for a small number of spheres. If performance is of primary concern there are faster methods (see Kubas' and Michael E2's answers for example). – Thies Heidecke Sep 14 '17 at 12:56
Graphics3D[{
Sphere[Select[list, Abs[Norm[#] - 3] < .1 &], .1]
,  Style[Sphere[{0, 0, 0}, 3], Opacity[0.4], Red]
}]


A couple of numerical ways, which should be faster on larger problems:

(* auxiliary function: returns 1/0 if arg is in/out the interval {a, b} *)
intervalMember[a_, b_] := UnitStep[# - a] UnitStep[b - #] &;

Pick[list, Norm /@ N@list // intervalMember[3 - 0.1, 3 + 0.1], 1]

Pick[list, #.# & /@ N@list // intervalMember[(3 - 0.1)^2, (3 + 0.1)^2], 1]

(*  {{-2, -2, -1},..., {2, 2, 1}} -- outputs centers  *)


Yet another way, which is pretty fast (Nearest returns a list sorted by distance):

nf = Nearest[N@list];
Drop[
nf[{0, 0, 0}, {All, 3 + 0.1}],
Length@nf[{0, 0, 0}, {All, 3 - 0.1}]]


For the specific problem in the OP (large integer radius 3 sphere, centers of small spheres on integer grid, only integer coordinates within small spheres are at the centers):

Pick[list, #.# & /@ list, 3^2]


You can use Select together with RegionIntersection to filter out the tuples you want:

list = Tuples[Table[i, {i, -2, 2}], 3];
int = Select[
list,
RegionIntersection[Sphere[#, 0.1], Sphere[{0, 0, 0}, 3]] =!= EmptyRegion &
];
Graphics3D[
{
Sphere[list, 0.1],
Blue, Sphere[int, 0.1],
Opacity@0.4, Red, Sphere[{0, 0, 0}, 3]
}
] You can also see from the above how you can simplify your code for the plot a bit:

• Sphere (and most the other graphics primitives) accept lists of points
• You can simply put your graphics directives in the first argument of Graphics/Graphics3D, no need for Style (just insert nested lists if you don't want a style to affect what comes later, e.g. {{Red,Sphere[pt1]},Sphere[pt2]} to only make the first sphere red)
• Isn't it what Thies suggested? – Kuba Sep 14 '17 at 11:20
• More or less, yes - I failed to reload the answers before posting. Afterwards, I thought I'd leave this since this gives the list of tuples that generate the spheres, rather than the list of spheres – Lukas Lang Sep 14 '17 at 11:22