11
$\begingroup$

I got such a wonderful answer regarding The Diagonals of a Regular Octagon, so I thought I'd try asking another question we had on our Pizza and Problem quiz activity at College of the Redwoods. The question was:

A 4 × 4 × h rectangular box contains a sphere of radius 2 and eight smaller spheres of radius 1. The smaller spheres are each tangent to three sides of the box, and the larger sphere is tangent to each of the smaller spheres. What is h?

enter image description here

I'd like to learn how to construct such a model using Mathematica and determine the height h of the box.

Thanks for any help.

$\endgroup$
14
$\begingroup$

Your question is like a sangaku problem. What is the distance between the centre of the large sphere and one of the smaller spheres? The large sphere centre is $\{2,2,h/2\}$, one of the small spheres is at $\{1,1,1\}$. Their separation equals the sum of their radii. That is,

Norm[{2, 2, h/2} - {1, 1, 1}] == 1 + 2

Solve the expression for $h$, and choose the positive root, $h=2(1+\sqrt{7})$.

With[{h = 2 (1 + Sqrt[7])},
   Graphics3D[{Orange,
      Sphere[{1, 1, 1}, 1], Sphere[{3, 1, 1}, 1], Sphere[{1, 3, 1}, 1],
      Sphere[{3, 3, 1}, 1], Sphere[{1, 1, h - 1}, 1], 
      Sphere[{3, 1, h - 1}, 1],
      Sphere[{1, 3, h - 1}, 1], Sphere[{3, 3, h - 1}, 1],
      Red, Sphere[{2, 2, h/2}, 2]
     }, Lighting -> "Neutral",Axes->True]]

tangent spheres

$\endgroup$
  • $\begingroup$ Tremendous answer. I am having so much fun this morning with the responses on Mathematica Stack Exchange. Thanks you. $\endgroup$ – David Sep 26 '15 at 19:09
14
$\begingroup$

KennyColnago's answer is good, but we're using Mathematica, so we can leave much more of the problem to it. Now, we can't avoid writing down the system of equations; for simplicity, I'll assume that the large sphere (with radius $R = 2$) is centered at the origin, and that the small spheres (with radius $r = 1$) are centered at ${x, y, z}$. The sides of the box lie at $\pm2$, and the top and bottom are at $\pm h$, so we have tangent small spheres for any combination of positive and negative $x$, $y$ and $z$. That means we know the following:

In[1]:= eqns = {
           (* each sphere is tangent to the sides of the box *)
           Abs[x] + r == 2,
           Abs[y] + r == 2,

           (* each sphere is tangent to the top of the box *)
           Abs[z] + r == h/2,

           (* because the large sphere and small sphere are tangent 
              to one another, their radii are collinear, so their 
              total length is the distance of the center of the small
              sphere from the origin. *)
           r + R == Norm[{x, y, z}],

           (* h is positive *)
           0 < h
        } /. {r -> 1, R -> 2};

Now, we can use Mathematica to solve those equations for $x$, $z$ and $h$.

In[2]:= sol = Simplify@Solve[eqns, {x, y, z, h}, Reals]
Out[2]= {{x -> -1, y -> -1, z -> -Sqrt[7], h -> 2 (1 + Sqrt[7])}, 
         {x -> -1, y -> -1, z -> Sqrt[7], h -> 2 (1 + Sqrt[7])}, 
         {x -> -1, y -> 1, z -> -Sqrt[7], h -> 2 (1 + Sqrt[7])}, 
         {x -> -1, y -> 1, z -> Sqrt[7], h -> 2 (1 + Sqrt[7])}, 
         {x -> 1, y -> -1, z -> -Sqrt[7], h -> 2 (1 + Sqrt[7])}, 
         {x -> 1, y -> -1, z -> Sqrt[7], h -> 2 (1 + Sqrt[7])}, 
         {x -> 1, y -> 1, z -> -Sqrt[7], h -> 2 (1 + Sqrt[7])},  
         {x -> 1, y -> 1, z -> Sqrt[7], h -> 2 (1 + Sqrt[7])}}

In[3]:= Length@sol
Out[3]= 8

Gratifyingly, we have eight solutions, one for each small sphere.

Now we can draw our spheres, which is easy because Mathematica has helpfully collected all the solutions as a list of rules.

In[3]:= centers = {x, y, z} /. sol
Out[3]= {{-1, -1, -Sqrt[7]}, {-1, -1, Sqrt[7]}, 
         {-1, 1, -Sqrt[7]}, {-1, 1, Sqrt[7]}, 
         {1, -1, -Sqrt[7]}, {1, -1, Sqrt[7]}, 
         {1, 1, -Sqrt[7]}, {1, 1, Sqrt[7]}}

Pulling it all together, we get:

In[4]:= Graphics3D[{
           {Lighter@Lighter@Red,
            Sphere[centers, r]},

           {Lighter@Green,
            Sphere[{0, 0, 0}, R]},

           Opacity[0],
           EdgeForm[Thick],
           Parallelepiped[{-2, -2, -h/2}, 
            {{4, 0, 0}, {0, 4, 0}, {0, 0, h}}]} /. sol /. {r -> 1, R -> 2},

       Boxed -> False]

The spherey horror of Yog Sothoth

EDIT to add: I've updated this answer a couple times, each time to shift more work to Mathematica. In my first attempt, which I didn't post, I got the wrong answer because of a stupid typo when I plugged the radii of the spheres into the Pythagorean theorem; switching over to Norm fixed that. Then I told Solve to assume that $x$ and $z$ were positive (while using the "obvious" fact that $|y| = |x|$ to eliminate an equation before solving), and did some complicated thing with Tuples and Transpose to get all eight spheres. Eliminating those assumptions and recasting everything in terms of absolute values meant Solve took care of all of that automatically.

EDIT again to tweak the Solve expression to specify the domain for Reals and include y, which seems necessary for everything to work right in Mathematica v11.

$\endgroup$
  • $\begingroup$ @Pilsy Another tremendous answer. I am sharing these with the students and teachers who attended our activity. $\endgroup$ – David Sep 26 '15 at 19:10

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.