Community RSS Feed
http://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Visual Arts sorted by active[GIF] Caught (Voronoi cells of stereographically projected pattern)
http://community.wolfram.com/groups/-/m/t/1286395
![Voronoi cells of stereographically projected pattern][1]
**Caught**
Continuing with the stereographic projection theme. This time, I generated a bunch of points arranged in spirals on the sphere, like so:
![Points on the sphere][2]
Then I stereographically project the points to the plane and compute the Voronoi diagram of the resulting points. Throw in a rotation of the sphere and you get the above animation.
As for the code, first of all we need the stereographic projection map:
Stereo[p_] := p[[;; -2]]/(1 - p[[-1]])
Next, we need to define the points. It turned out that without throwing in some noise in the definition of the points, `VoronoiMesh[]` would occasionally fail, which is why I put in the `RandomVariate[]` business in both cylindrical coordinates:
pts = With[{n = 20},
Table[
CoordinateTransformData["Cylindrical" -> "Cartesian", "Mapping"]
[{Sqrt[1 - (z + #)^2], θ + RandomVariate[UniformDistribution[{-.00001, .00001}]]
+ (z + # + 2)/2 * π/2, z + #}
&[RandomVariate[UniformDistribution[{-.00001, .00001}]]]
],
{z, -.9, .9, 2/n}, {θ, 0, 2 π - 2 π/n, 2 π/n}]
];
Finally, then, here's the animation:
With[{cols = RGBColor /@ {"#F5841A", "#03002C"}},
Manipulate[
VoronoiMesh[
Stereo[RotationMatrix[θ, {1., 0, 0}].#] & /@ Flatten[pts, 1],
{{-4.1, 4.1}, {-4.1, 4.1}}, PlotTheme -> "Lines", PlotRange -> 4,
MeshCellStyle -> {{1, All} -> Directive[Thickness[.005], cols[[1]]]},
ImageSize -> 540, Background -> cols[[-1]]],
{θ, 0, π}
]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=r11Lqrc.gif&userId=610054
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5946Untitled-13.png&userId=610054Clayton Shonkwiler2018-02-16T21:10:29Z