Group Abstract Group Abstract

Message Boards Message Boards

[GIF] Pack It In (Stereographic projection of circles)

3 Replies

enter image description here - Congratulations! This post is now a Staff Pick as distinguished on your profile! Thank you, keep it coming!

POSTED BY: EDITORIAL BOARD
Posted 8 years ago

Here is a slight shortening of Clayton's code:

DynamicModule[{p, b, verts = Normalize /@ N[PolyhedronData["Cube", "VertexCoordinates"]],
               t = ArcCos[1/3]/2, cols = RGBColor /@ {"#EF6C35", "#2BB3C0", "#161C2E"}}, 
              Manipulate[p = verts.RotationMatrix[-?, {1, 0, 0}]; b = NullSpace[{#}] & /@ p;
                         Graphics[{EdgeForm[], Table[{cols[[Quotient[i, 4, -3]]], 
                                   Polygon[Table[Most[#]/(1 - Last[#]) &[
                                                 Cos[t] p[[i]] + Sin[t] ({Cos[s], Sin[s]}.b[[i]])],
                                                 {s, 0, 2 ?, 2 ?/200}]]}, {i, Length[verts]}]}, 
                                  PlotRange -> Sqrt[6], Background -> cols[[-1]], ImageSize -> 540],
                         {?, 0, ?/2}]]

Notes:

  1. Dot products are very efficient in Mathematica, thus the new direct expression for p (accounting for the need to transpose) is much faster than mapping a dot product all over a list.
  2. Using inexact coordinates in this case, apart from the easier internal handling, allows NullSpace[] to use the singular value decomposition (SVD) internally, thus obviating the need for an extra Orthogonalize[].
POSTED BY: J. M.

I need to carve "Did you remember to use N[]?" into my wall or something. Exact calculations have caused me so many problems over the years, but I still forget all the time.

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard