Community RSS Feed
http://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Visual Arts sorted by active[GIF] Eyes Wide (Stereographic projection of spherical circle packing)
http://community.wolfram.com/groups/-/m/t/1167789
![Stereographic projection of optimal circle packing of the sphere by five circles][1]
**Eyes Wide**
Very much in the same spirit as [_Pack It In_][2], this shows the stereographic image of the optimal packing of the sphere by five circles. The circles are centered at the (normalized) vertices of the triangular bipyramid.
The coloration is misleading, in that the five circles _are_ partitioned into a group of three (the three centered on points $120^\circ$ apart on the equator) and a group of two (the two centered on the north and south poles), but the colors don't match up with those groupings. The two blue circles are two of the three circles centered on the equator; the third is the one circle that doesn't touch those two blue circles.
Anyway, here's the code:
Stereo[p_] := Most[p]/(1 - Last[p]);
DynamicModule[{p, b, t = π/4.,
verts =
RotationTransform[π/6, {0, 0, 1}][Normalize[N[#]]] & /@ PolyhedronData[{"Dipyramid", 3}, "VertexCoordinates"],
cols = RGBColor /@ {"#B91372", "#41EAD4", "#011627"}},
Manipulate[
p = verts.RotationMatrix[-θ, {1, 0, 0}];
b = Orthogonalize[NullSpace[{#}]] & /@ p;
Graphics[
{FaceForm[None],
Table[
{EdgeForm[
Directive[Thickness[.0075], cols[[Mod[Ceiling[i/3], 2, 1]]]]],
Polygon[Table[Stereo[Cos[t] p[[i]] + Sin[t] (Cos[s] b[[i, 1]] + Sin[s] b[[i, 2]])], {s, 0, 2 π, 2 π/200}]]},
{i, 1, Length[verts]}]},
PlotRange -> 5, Background -> cols[[-1]], ImageSize -> 540],
{θ, 0, 2 π}]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=packing12tc.gif&userId=610054
[2]: http://community.wolfram.com/groups/-/m/t/1166591Clayton Shonkwiler2017-08-21T04:45:07Z[GIF] Pack It In (Stereographic projection of circles)
http://community.wolfram.com/groups/-/m/t/1166591
![Stereographic projection of circles centered at cube vertices][1]
**Pack It In**
Consider the eight vertices of the cube as points on the unit sphere, then make (spherical) circles centered on those points with radii chosen so that the circles are just tangent. Then this gives a packing of the sphere by 8 circles of (spherical) radius $\frac{1}{2} \arccos \left(\frac{1}{3}\right) \approx 0.61548$. (Of course, this is not the optimal packing by 8 circles; that is given by circles centered on the vertices of the square antiprism.)
Now, rotate the sphere and the eight circles around the $x$-axis and stereographically project down to the plane. After adding some color, the result is this animation.
Here's the code:
Stereo[{x_, y_, z_}] := 1/(1 - z) {x, y};
DynamicModule[{p, b,
verts = Normalize /@ PolyhedronData["Cube", "VertexCoordinates"],
t = 1/2 ArcCos[1/3],
cols = RGBColor /@ {"#EF6C35", "#2BB3C0", "#161C2E"}},
Manipulate[
p = RotationMatrix[θ, {1, 0, 0}].# & /@ verts;
b = Orthogonalize[NullSpace[{#}]] & /@ p;
Graphics[{EdgeForm[None],
Table[{cols[[Floor[(i - 1)/4] + 1]],
Polygon[Table[Stereo[Cos[t] p[[i]] + Sin[t] (Cos[s] b[[i, 1]] + Sin[s] b[[i, 2]])], {s, 0, 2 π, 2 π/200}]]},
{i, 1, Length[verts]}]}, PlotRange -> Sqrt[6],
Background -> cols[[-1]], ImageSize -> 540],
{θ, 0, π/2}]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=packing5.gif&userId=610054Clayton Shonkwiler2017-08-17T21:46:10Z