The Science of Sticky Spheres: Illustrations and Animations

Data and procedures for generating the illustrations that accompany “Computing Science: The Science
of Sticky Spheres,” by Brian Hayes, American Scientist, November–December 2012, 100:442–449.

For more information see http://www.americanscientist.org/issues/pub/2012/6/the-science-of-sticky-spheres
and http://bit-player.org/2012/dancing-with-the-spheres

Coordinates of spheres in clusters.

Each set of coordinates is a list of lists, where the inner lists are coordinates in {x, y, z} order. See below for procedures used to generate some of these coordinates. Most of them are given as exact, analytic values. Whenever possible, the structure is positioned and oriented so that the z axis is an axis of symmetry.

n=2 C(n)=1

dimerCoords = {{-(1/2), 0, 0}, {1/2, 0, 0}}

n=3 C(n)=3

triangleCoords = {{-(1/2), 1/(2*Sqrt[3]), 0}, {1/2, 1/(2*Sqrt[3]), 0}, {0, -(1/Sqrt[3]), 0}}

n=4 C(n)=6

tetrahedronCoords = {{-(1/2), 1/(2*Sqrt[3]), 0}, {1/2, 1/(2*Sqrt[3]), 0}, {0, -(1/Sqrt[3]), 0}, 
   {0, 0, Sqrt[2/3]}}

n=5 C(n)=9 two tetrahedra joined across a face

triangularDipyramidCoords = {{-(1/2), 1/(2*Sqrt[3]), 0}, {1/2, 1/(2*Sqrt[3]), 0}, {0, -(1/Sqrt[3]), 0}, 
   {0, 0, Sqrt[2/3]}, {0, 0, -Sqrt[2/3]}}

n=6 C(n)=12 three face-joined tetrahedra

triTetrahedronCoords = {{-(1/2), 1/(2*Sqrt[3]), 0}, {1/2, 1/(2*Sqrt[3]), 0}, {0, -(1/Sqrt[3]), 0}, 
   {0, 0, Sqrt[2/3]}, {0, 0, -Sqrt[2/3]}, {5/6, -(5/(6*Sqrt[3])), (2*Sqrt[2/3])/3}}

n=6 C(n)=12

octahedronCoords = {{-(1/Sqrt[2]), 0, 0}, {0, 1/Sqrt[2], 0}, {0, 0, -(1/Sqrt[2])}, {0, 0, 1/Sqrt[2]}, 
   {0, -(1/Sqrt[2]), 0}, {1/Sqrt[2], 0, 0}}

n=7 C(n)=15 The first of three configurations of four tetrahedra glued across faces. This one has an axis of threefold 
rotational symmetry passing through the central tetrahedron.

tetraTetrahedronSymmetricCoords = {{-(1/2), 1/(2*Sqrt[3]), 0}, {1/2, 1/(2*Sqrt[3]), 0}, {0, -(1/Sqrt[3]), 0}, 
   {0, 0, Sqrt[2/3]}, {-(5/6), -(5/(6*Sqrt[3])), (2*Sqrt[2/3])/3}, 
   {5/6, -(5/(6*Sqrt[3])), (2*Sqrt[2/3])/3}, {0, 5/(3*Sqrt[3]), (2*Sqrt[2/3])/3}}

n=7 C(n)=15 The second of three configurations of four tetrahedra glued across faces. This one has a helical form, with left-handed and 
right-handed configurations. The coordinates given here are for the right-handed enantiomer.

tetraTetrahedronChiralCoords = {{-(1/2), 1/(2*Sqrt[3]), 0}, {1/2, 1/(2*Sqrt[3]), 0}, {0, -(1/Sqrt[3]), 0}, 
   {0, 0, Sqrt[2/3]}, {0, 0, -Sqrt[2/3]}, {5/6, -(5/(6*Sqrt[3])), (2*Sqrt[2/3])/3}, 
   {8/9, 7/(9*Sqrt[3]), (10*Sqrt[2/3])/9}}

n=7 C(n)=15 The third of three configurations of four tetrahedra glued across faces. This one is an “almost pentagon,” with a gap just slightly
too wide to fill with a fifth tetrahedron.

tetraTetrahedronGapCoords=
{{0,0,-1/2},
{0,0,1/2},
{0,Sqrt[3/4],0},
{-Sqrt[2/3],1/(2 Sqrt[3]),0},
{Sqrt[2/3],1/(2 Sqrt[3]),0},
{(2 Sqrt[2/3])/3,-7/(6 Sqrt[3]),0},
{-(2 Sqrt[2/3])/3,-7/(6 Sqrt[3]),0}}

n=7 C(n)=15 An octahedron with a tetrahedron erected on one face

octahedronPlusOneCoords = {{-(1/Sqrt[2]), 0, 0}, {0, 1/Sqrt[2], 0}, {0, 0, -(1/Sqrt[2])}, 
   {0, 0, 1/Sqrt[2]}, {0, -(1/Sqrt[2]), 0}, {1/Sqrt[2], 0, 0}, {1/Sqrt[2], 1/Sqrt[2], 1/Sqrt[2]}}

n=7 C(n)=15 A regular pentagon centered at the origin in the {x, y} plane,with each of the five vertices linked to two more nodes above and below the
origin on the z axis. Coordinates were calculated by first laying out the penatgon and then solving for the height of the two central nodes.

pentaPyramidCoords = {{0, (1/10)*Sqrt[50 + 10*Sqrt[5]], 0}, 
   {(1/10)*Sqrt[(5/8 + Sqrt[5]/8)*(50 + 10*Sqrt[5])], (1/40)*(-1 + Sqrt[5])*Sqrt[50 + 10*Sqrt[5]], 0}, 
   {(1/10)*Sqrt[(5/8 - Sqrt[5]/8)*(50 + 10*Sqrt[5])], (1/40)*(-1 - Sqrt[5])*Sqrt[50 + 10*Sqrt[5]], 0}, 
   {(-(1/10))*Sqrt[(5/8 - Sqrt[5]/8)*(50 + 10*Sqrt[5])], (1/40)*(-1 - Sqrt[5])*Sqrt[50 + 10*Sqrt[5]], 
    0}, {(-(1/10))*Sqrt[(5/8 + Sqrt[5]/8)*(50 + 10*Sqrt[5])], (1/40)*(-1 + Sqrt[5])*
     Sqrt[50 + 10*Sqrt[5]], 0}, {0, 0, -Sqrt[(1/10)*(5 - Sqrt[5])]}, {0, 0, Sqrt[(1/10)*(5 - Sqrt[5])]}}

n=8 C(n)=18 This structure can be described as two conjoined pentagonal dipyramids, oriented at right angles. The joining 
process causes distortions, so that neither of the pentagons is regular. This was the only cluster for which I could not find a way
to determine all the coordinates by a progressive or incremental algorithm, starting from some fixed triangle and adding points 
one at a time. Instead I had to solve for five variables at once; I did so numerically rather than analytically.

newSeedEightCoords={{-(1/2),0,0},{1/2,0,0},{0,-0.644584,-0.578369},{0,0.644584,-0.578369},{-0.644584,0,-0.989492},{0.644584,0,-0.989492},{0,-(1/2),-1.56786},{0,1/2,-1.56786}}

n=9 C(n)=21 The flexible “wiggler.”

nonRigidNineCoords={{0,0,0},{-1,0,0},{1,0,0},{-1/2,0,Sqrt[3]/2},{1/2,0,Sqrt[3]/2},{-1/2,-Sqrt[2/3],1/(2 Sqrt[3])},{-1/2,Sqrt[2/3],1/(2 Sqrt[3])},{1/2,-Sqrt[2/3],1/(2 Sqrt[3])},{1/2,Sqrt[2/3],1/(2 Sqrt[3])}}

n=10 C(n)=25 Adding a single node to the flexible structure above eliminates the torsional
degree of freedom. The added node forms an octahedral cap over one of the cluster’s two 
square faces. Note that this is the first cluster for which C(n) > 3n-6.

unFloppyTenCoords = {{0, 0, 0}, {-1, 0, 0}, {1, 0, 0}, {-2^(-1), 0, Sqrt[3]/2}, {1/2, 0, Sqrt[3]/2}, 
   {-2^(-1), -Sqrt[2/3], 1/(2*Sqrt[3])}, {-2^(-1), Sqrt[2/3], 1/(2*Sqrt[3])}, 
   {1/2, -Sqrt[2/3], 1/(2*Sqrt[3])}, {1/2, Sqrt[2/3], 1/(2*Sqrt[3])}, {0, Sqrt[2/3], 2/Sqrt[3]}}

n=10 C(n)=25 Two octahedra joined along an edge, with two additional bonds 
formed where corners of the octahedra lie at distance 1. C(n) > 3n-6.

tenDoubleOctahedronCoords={{-1,0,0},{0,0,0},{1,0,0},{-1,0,1},{0,0,1},{1,0,1},
{-1/2,-1/Sqrt[2],1/2},{-1/2,1/Sqrt[2],1/2},{1/2,-1/Sqrt[2],1/2},{1/2,1/Sqrt[2],1/2}}

n=11 C(n)=29 The unique 11-sphere cluster with 29 contacts. Formed
incrementally from the unFloppyTenCoords structure, which in turn derives 
from the nonRigidNineCoords. Now both of the square faces on the nonRigidNine
have octahedral caps.

eleven29Coords={{0,0,0},{-1,0,0},{1,0,0},{-1/2,0,Sqrt[3]/2},{1/2,0,Sqrt[3]/2},{-1/2,-Sqrt[2/3],1/(2 Sqrt[3])},{-1/2,Sqrt[2/3],1/(2 Sqrt[3])},{1/2,-Sqrt[2/3],1/(2 Sqrt[3])},{1/2,Sqrt[2/3],1/(2 Sqrt[3])},{0,-Sqrt[2/3],2/Sqrt[3]},{0,Sqrt[2/3],2/Sqrt[3]}}

n = 12 C (n) = 33
This is NOT one of the clusters identified by Arkus et al. or by Hoy et al. as max C(n) clusters. Their
searches went only as far as n=11. But this 12-sphere cluster is the obvious culmination of the series
nonRigidNine, unFloppyTen, eleven29. A triangular dipyramid is added to the top of the structure,
connecting the two octahedral caps.

twelve33Coords={{0,0,0},{-1,0,0},{1,0,0},{-1/2,0,Sqrt[3]/2},{1/2,0,Sqrt[3]/2},{-1/2,-Sqrt[2/3],1/(2 Sqrt[3])},{-1/2,Sqrt[2/3],1/(2 Sqrt[3])},{1/2,-Sqrt[2/3],1/(2 Sqrt[3])},{1/2,Sqrt[2/3],1/(2 Sqrt[3])},{0,-Sqrt[2/3],2/Sqrt[3]},{0,Sqrt[2/3],2/Sqrt[3]},{0,0,Sqrt[3]}}

Three more clusters connected with the Newton kissing-number problem. The issue here is not
how many contacts overall but how many contacts with the central sphere.

The suboctahedron is essentially a chunk extracted from the infinite Kepler packing (hexagonal close-packing
or face-centered cubic, depending on your point of view). Note that the central sphere at {0, 0, 0} is not included in the list.

cuboctahedronCoords={{-1,0,0},{1,0,0},{-1/2,Sqrt[3]/2,0},{1/2,Sqrt[3]/2,0},{-1/2,-Sqrt[3]/2,0}, {1/2,-Sqrt[3]/2,0},{-1/2,Sqrt[3]/6,Sqrt[2/3]},{0,-Sqrt[3]/3,Sqrt[2/3]},{1/2,Sqrt[3]/6,Sqrt[2/3]},{-1/2,-Sqrt[3]/6,-Sqrt[2/3]},{0,Sqrt[3]/3,-Sqrt[2/3]},{1/2,-Sqrt[3]/6,-Sqrt[2/3]}}

The icosahedron is an alternative way of packing 12 spheres around a central sphere with a
kissing number of 12. Note that the central sphere at {0, 0, 0} is not included in the list.

icosCoords=PolyhedronData["Icosahedron","VertexCoordinates"]

This is the configuration suggested by Schütte and van der Waerden as the best way of packing 13 spheres
around a 14th central sphere. The coordinates were calculated by Hugo Pfoertner (see http://www.randomwalk.de/sphere/insphr/sequences.txt).
Note that the central sphere at {0, 0, 0} is not included in the list.

dreizehnCoords={{0.,0.,1.04557},{0.878247,0.,0.567366},{0.,0.878247,0.567366},{-0.878247,0.,0.567366},{0.,-0.878247,0.567366},{0.736324,0.736324,-0.0942118},{-0.736324,0.736324,-0.0942115},{-0.736324,-0.736324,-0.0942112},{0.736324,-0.736324,-0.0942113},{0.707107,0.,-0.770209},{0.,0.707107,-0.770209},{-0.707107,0.,-0.770209},{0.,-0.707107,-0.770209}}

Procedures used in compiling the coordinates.

Given the three vertices of a suitable triangle in three-dimensional space, calculate and
return the coordinates of the two points at unit distance from all three vertices. What’s a 
suitable triangle? Not degenerate: The three vertices cannot be colinear. And not too
big: The maximum distance between pairs of vertices is <= 2. There is no checking 
that these conditions are satisfied; break the rules and you’ll get back imaginary
results or no results. Note: ‘Solve’ returns lists of substitution rules, along the lines 
of x--> 0, y-->1; mapping ‘Part[]’ over this structure selects the results and removes the labels.

tetrahedralPoint[p1_,p2_,p3_]:=
Module[{
soln=Solve[
(x-p1[[1]])^2+(y-p1[[2]])^2+(z-p1[[3]])^2==1&&
(x-p2[[1]])^2+(y-p2[[2]])^2+(z-p2[[3]])^2==1&&
(x-p3[[1]])^2+(y-p3[[2]])^2+(z-p3[[3]])^2==1,{x,y,z}]},
{soln,Map[Part[#,2]&,soln,{2}]}]

Useful for checking sets of coordinates for plausibility. Returns a list of all pairwise distances.

mapDistances[pts_]:=
Module[{pairs=Subsets[pts,{2}]},
Map[EuclideanDistance[#[[1]],#[[2]]]&,pairs]]

Computation of coordinates for ‘newSeedEight’, which I was unable to solve by any sequence
of applications of ‘tetrahedralPoint’. The cluster can be positioned and oriented so that four
vertices have x=0 and four have y=0. These facts and symmetry pin down 14 of the 24 needed
coordinate values. We need to find the other 10, but symmetry again applies and we can solve
for just five.

Block[
{y4,z4,z8,x6,z6},
Module[{
p1={-1/2,0,0},
p2={1/2,0,0},
p8={0,1/2,z8},
p4={0,y4,z4},
p6={x6,0,z6}},
NSolve[
(0-(-1/2))^2+(y4-0)^2+(z4-0)^2==1&&  (* p4 & p1 *)
(0-1/2)^2+(y4-0)^2+(z4-0)^2==1&&  (* p4 & p2 *)
(0-0)^2+(y4-1/2)^2+(z4-z8)^2==1&& (* p4 & p8 *)
(0-x6)^2+(y4-0)^2+(z4-z6)^2==1&& (* p4 & p6 *)
(x6-1/2)^2+(0-0)^2+(z6-0)^2==1&& (* p6 & p2 *)
(x6-0)^2+(0-1/2)^2+(z6-z8)^2==1&& (* p6 & p8 *)
y4>0&&z4>0&&z8>0&&x6>0&&z6>0, (* first quadrant *)
{y4,z4,z8,x6,z6},Reals]]]

Procedures used in constructing the skeleton.
Here we create the 'bones' of the diagrams, the Geomag-like
network of rods connecting sphere centers.

Predicate that returns True iff pt1 and pt2 are within ±epsilon of distance 1.

edgeQ[pt1_,pt2_,epsilon_]:=
Module[{d=EuclideanDistance[pt1,pt2]},
Abs[d-1]≤epsilon]

Consider all pairs of vertices and return a lost of pairs at distance 1.

edgeList[pts_,epsilon_]:=
Module[{pairs=Subsets[pts,{2}]},
Select[pairs,edgeQ[#[[1]],#[[2]],epsilon]&]]

Create the 3D graphics objects---a small sphere at the center point of each sphere,
and a thin cylinder connecting the centers.

skeleton[coords_,epsilon_]:=
Module[{edges=edgeList[coords,epsilon]},
{Map[Tube[#]&,edges],Map[Sphere[#,1/20]&,coords]}]

Find the vertex farthest from the origin, and return this radius plus 1/2. The radius
will be used to construct an invisible envelope sphere that encloses the entire cluster.

boundingRadius[coords_]:=
1/2 + Max[Map[EuclideanDistance[#,{0,0,0}]&,coords]]

Generating 3D graphics.

Create a static image as a 3D graphics object. Arguments: ‘coords’ is a list of lists of x, y, z values;
‘epsilon’ is an error tolerance for deciding whether two spheres are touching, typical values around 0.01;
‘theta’ is the orientation of the object around the z axis.

make3dView[coords_,epsilon_,theta_]:=
Module[
{bones={Opacity[1.0],skeleton[coords,epsilon]},
balls={Opacity[0.5],Map[Sphere[#,1/2]&,coords]},
envelope={Opacity[0.0], Sphere[{0,0,0},boundingRadius[coords]]}},
Graphics3D[Rotate[{bones,balls,envelope},theta*Degree,{0,0,1}],ViewPoint->{0,5,3},Boxed->False,SphericalRegion->True,ImageSize->800*boundingRadius[coords]]]

Conventional binocular stereo pair, hacked together without a great deal of thought. The additional
argument ‘disparity’ represents the interocular distance. I find that 0.4 works well for me.

makeStereoView[coords_,epsilon_,theta_,disparity_]:=
Module[
{bones={Opacity[1.0],skeleton[coords,epsilon]},
balls={Opacity[0.5],Map[Sphere[#,1/2]&,coords]}},
GraphicsRow[{
Graphics3D[Rotate[{bones,balls},theta*Degree,{0,0,1}],ViewPoint->{disparity/2,5,3},Boxed->False,SphericalRegion->False,ImageSize->800*boundingRadius[coords]],
Graphics3D[Rotate[{bones,balls},theta*Degree,{0,0,1}],ViewPoint->{-disparity/2,5,3},Boxed->False,SphericalRegion->False,ImageSize->800*boundingRadius[coords]]}]]

Twirling 3D graphics in an animated GIF file. The basic idea is to build the same kind of graphics
object that make3dView creates, then rotate it through a series of angles, store the results in a table,
and finally call the ‘Export’ function on this table. ‘Export’ takes care of building the animated GIF.
Incidentally, you might want to issue a ‘SetDirectory’ command, such as SetDirectory[NotebookDirectory[]],
so that you know where to look for the output of this procedure and others like it.

makeSpinner[coords_,epsilon_,filename_,thetaStart_,thetaEnd_,thetaDelta_]:=
Module[
{bones={Opacity[1.0],skeleton[coords,epsilon]},
balls={Opacity[0.5],Map[Sphere[#,1/2]&,coords]},
envelope={Opacity[0.0], Sphere[{0,0,0},boundingRadius[coords]]}},
Export[filename,Table[Graphics3D[Rotate[{bones,balls,envelope},x* Degree,{0,0,1}],ViewPoint->{0,5,3},Boxed->False,SphericalRegion->True],{x,thetaStart,thetaEnd,thetaDelta}],"GIF",ImageSize->500]]

The wiggling 9-sphere cluster.

Solve for the coordinates of all the spheres after the structure is twisted through angle theta. (Theta in
radians; sorry for the inconsistency.) This returns a list of coordinates, not a graphics object.

wiggleNine[theta_]:=
Module[{a,b,c,d,e,f,g,h,i},

(* a, b and c are the keel of the structure  *)
a={-1,0,0}; 
b={0,0,0};
c={1,0,0};

(* d and e are the tips of the two masts *)
d={-1/2,Sin[theta]*Sqrt[3]/2,Cos[theta]*Sqrt[3]/2}; 
e ={1/2,-Sin[theta]*Sqrt[3]/2,Cos[theta]*Sqrt[3]/2};

(* f and g are the outriggers on the -x end of the boat *)
f=tetrahedralPoint[a,b,d][[1]];
g=tetrahedralPoint[a,b,d][[2]];

(* h and i are the outriggers on the +x end of the boat *)
h=tetrahedralPoint[b,c,e][[1]];
i=tetrahedralPoint[b,c,e][[2]];

(* return the list of coordinates *)
{a,b,c,d,e,f,g,h,i}]

Construct and save the animated GIF for the wiggling cluster.

makeWiggler[epsilon_,filename_,thetaMax_,steps_]:=
Module[{coords,bones,balls,g3d,theta,thetaDelta},
g3d={};
theta=0;
thetaDelta=thetaMax/steps;
For[i=0,i≤(steps*4),i++,
coords=wiggleNine[theta];
bones={Opacity[1.0],skeleton[coords,epsilon]};
balls={Opacity[0.5],Map[Sphere[#,1/2]&,coords]};
AppendTo[g3d,Graphics3D[{bones,balls},ViewPoint->{-4,5,5},Boxed->False,SphericalRegion->True]];
theta+=thetaDelta;
thetaDelta=If[Abs[theta]≥thetaMax,-thetaDelta,thetaDelta]];
Export[filename,g3d,"GIF",ImageSize->500]]

Test routine that produces a static image for a given epsilon and theta; allows for 
measuring how far the structure can be twisted without breaking bonds.

wigglerTest[epsilon_,theta_]:=
Module[{coords,bones,balls},
coords=wiggleNine[theta];
bones={Opacity[1.0],skeleton[coords,epsilon]};
balls={Opacity[0.5],Map[Sphere[#,1/2]&,coords]};
Graphics3D[{bones,balls},ViewPoint->{-4,5,5},Boxed->False,SphericalRegion->True]]

The flexing transformation between 6-sphere variants.

Here we look at how breaking and remaking a single bond can transform a cluster from an
octahedron to a set of three fused tetrahedra (both with n=6 and C(n)=12). Named ‘coinPurse’
because it reminds me of the soft plastic football-shaped squeeze purses of my youth, which
opened when you pressed on the pointy ends.

coinPurseCoords[dist_]:=     (* dist is the opening distance *)
Module[{a,b,c,d,e,f,cz,fx,fz,soln},
soln = NSolve[(0 - 1/2)^2 + ((dist/2)-0)^2 + (cz-0)^2==1 && (* c and b *)
(0 - -1/2)^2 + ((dist/2)-0)^2 + (cz-0)^2==1 &&  (* c and a *)
(0 - fx)^2 + ((dist/2)-0)^2 + (cz-fz)^2==1 &&  (* c and f *)
(fx - 1/2)^2 + (0-0)^2 + (fz-0)^2==1 &&  (* f and b *)
cz>0 && fx>0&&fz>0,
{cz,fx,fz}];
soln=soln[[1]];
cz=soln[[1,2]];
fx=soln[[2,2]];
fz=soln[[3,2]];

(* a and b form the stationary keel, aligned on x axis *)
a={-1/2,0,0};
b={1/2,0,0};

(* c and d are dist apart on the y axis *)

c={0,dist/2,cz};
d={0,-dist/2,cz};

e={-fx,0,fz};
f={fx,0,fz};

(* return list of coords *)
{a,b,c,d,e,f}]

Generate the coinPurse animated GIF file.

makeCoinPurse[epsilon_,filename_,steps_]:=
Module[{coords,bones,balls,g3d,dist,distDelta},
g3d={};
dist=2/Sqrt[2];
distDelta=-(dist-1)/steps;
For[i=0,i≤(steps*2),i++,
coords=coinPurseCoords[dist];
bones={Opacity[1.0],skeleton[coords,epsilon]};
balls={Opacity[0.5],Map[Sphere[#,1/2]&,coords]};
AppendTo[g3d,Graphics3D[{bones,balls},ViewPoint->{1/2,3,5},Boxed->False,SphericalRegion->True]];
dist+=distDelta;
distDelta=If[dist≥1,distDelta,-distDelta]];
Export[filename,g3d,"GIF",ImageSize->500]]

Pentagonal dipyramid to tetratetrahedron.

The independent variable here is the separation between the top and bottom nodes of the
structure; the positions of the nodes on the pentagonal periphery are calculated in a cascade 
of dependencies from this datum.

breathingPentagonCoords[height_]:=
Module[{
top={0,0,height/2},
bot={0,0,-height/2}},
Module[{tailY,tail},
tailY=-Sqrt[1-(height/2)^2];
tail={0,tailY,0};
Module[{elbows,leftElbow,rightElbow},
elbows=tetrahedralPoint[tail,top,bot];
leftElbow=elbows[[1]];
rightElbow=elbows[[2]];
Module[{leftClaw,rightClaw},
leftClaw=tetrahedralPoint[leftElbow,top,bot];
leftClaw=If[leftClaw[[1,2]]>0,leftClaw[[1]],leftClaw[[2]]];
rightClaw=tetrahedralPoint[rightElbow,top,bot];
rightClaw=If[rightClaw[[1,2]]>0,rightClaw[[1]],rightClaw[[2]]];
{top,bot,leftClaw,leftElbow,tail,rightElbow,rightClaw}]]]]

makeBreathingPentagon[epsilon_,filename_,delta_]:=
Module[{coords,bones,balls,g3d,height,gap},
g3d={};
height=1;
coords=breathingPentagonCoords[height];
gap=EuclideanDistance[coords[[3]],coords[[7]]];
While[gap>1,
bones={Opacity[1.0],skeleton[coords,epsilon]};
balls={Opacity[0.5],Map[Sphere[#,1/2]&,coords]};
AppendTo[g3d,Graphics3D[{bones,balls},ViewPoint->{1/2,3,5},Boxed->False,SphericalRegion->True]];
height+=delta;
coords=breathingPentagonCoords[height];
gap=EuclideanDistance[coords[[3]],coords[[7]]]]
Export[filename,g3d,"GIF",ImageSize->900]];