Fitting In
For various reasons I've spent some time recently playing around with Neil Sloane's tables of putatively optimal packings of points on spheres and Grassmannians. This particular animations shows the best known way to put 124 points on the standard unit 2-sphere that maximizes the minimal distance between points. Here's how to import the points:
pack124 = Normalize /@
(Partition[
Import[
URLDownload[
"http://neilsloane.com/packings/dim3/pack.3.124.txt",
NotebookDirectory[] <> "pack.3.124.txt"], "List"][[2 ;;]],
3]);
Now, I put spherical circles of radius equal to half the minimal distance between points and stereographically project to the plane using the ProjectedSphericalCircle[]
function defined first for Small Changes. Add in a little rotation, and here's the code for the animation:
With[{cols = RGBColor /@ {"#f2f4fb", "#5e227f"}},
Manipulate[
Graphics[
{PointSize[Large], Thickness[.004], cols[[1]],
If[#[[3]] < .95, ProjectedSphericalCircle[#, 18.9539116*?/360], Nothing]
& /@ ((RotationMatrix[?, {1., 1., 1.}].RotationMatrix[{Mean[pack124[[{32, 85, 124}]]], {0, 0, -1.}}].#)
& /@ pack124)},
PlotRange -> 2, ImageSize -> 540, Background -> cols[[-1]]],
{?, 0, 2 ?}]
]