# [GIF] Move Along (Envelopes of conic sections)

Posted 2 years ago
3669 Views
|
|
6 Total Likes
|
 Move AlongConsider a circle of latitude at height $z=-3/4$ on the unit sphere. The orthogonal complements of unit vectors on the circle are planes through the origin in $\mathbb{R}^3$, which we can also interpret as lines in $\mathbb{RP}^2$, the real projective plane. In order to visualize these lines, take the intersection of the planes with the plane $z=1$. These lines will form the envelope of a circle in the $z=1$ plane. Now, as we rotate the unit sphere around the $y$-axis, the lines in the $z=1$ plane will form the envelopes of a family of conics. What the animation actually shows are the points of intersections of the lines corresponding to 50 equally-spaced points on this rotating circle on the unit sphere. Here's the code: DynamicModule[{m, p, a, θ = 0., t = π/1., r = -0.75, lines, linepairs, dots, cols = RGBColor /@ {"#E84A5F", "#2A363B"}}, Manipulate[ m = RotationMatrix[ t, {Cos[θ] Sin[ϕ], Sin[θ] Sin[ϕ], Cos[ϕ]}]; p[s_] = m.{Sqrt[1 - r^2] Cos[s], Sqrt[1 - r^2] Sin[s], r}; a = m.{0, 0, 1}; lines = Table[InfiniteLine[{{-p[s][[3]]/p[s][[1]], 0}, {0, -p[s][[3]]/p[s][[2]]}}], {s, 0, 2 π - 2 π/50, 2 π/50}]; linepairs = Subsets[lines, {2}]; dots = DeleteCases[RegionIntersection @@ # & /@ linepairs, EmptyRegion[2]]; Graphics[{White, PointSize[.005], cols[[1]], dots}, ImageSize -> 540, Frame -> False, Background -> cols[[-1]], PlotRange -> 5], {ϕ, 0, π/2}] ]