Select spheres intersecting with big sphere from list

Question

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?

Answer 1

list = Tuples[Table[i, {i, -2, 2}], 3];
smallspheres = Sphere[#, 1/10] & /@ list;
bigsphere = Sphere[{0, 0, 0}, 3];
MemberBigSphereQ = RegionIntersection[bigsphere, #] =!= EmptyRegion[3] &
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}]]

Answer 2

Graphics3D[{
    Sphere[Select[list, Abs[Norm[#] - 3] < .1 &], .1]
 ,  Style[Sphere[{0, 0, 0}, 3], Opacity[0.4], Red]
}]

Answer 3

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]

Answer 4

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[3] &
      ];
Graphics3D[
 {
  Sphere[list, 0.1],
  Blue, Sphere[int, 0.1],
  [email protected], 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)