Community RSS Feed
http://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Geometry sorted by activeRendering of RegionIntersection in 3D?
http://community.wolfram.com/groups/-/m/t/1283669
I am trying to visualize some region intersections in 3D.
## Example 1:
ra = 10;
ri = 5;
R1 = RegionDifference[Ball[{0, 0, 0}, ra], Ball[{0, 0, ri - 1/2}, ri]];
Show[R1 // Region, Axes -> True]
![rendered result][1]
The resulting rendered region has a hole, while it should not have one. Does anyone know a way to improve on this.
Another example.
## Example 2:
ra = 10;
ri = 5;
R1 = RegionDifference[Ball[{0, 0, 0}, ra], Ball[{0, 0, 0}, ri]];
R2 = Cylinder[{{-100, 0, 0}, {100, 0, 0}}, 5];
R = RegionIntersection[R1, R2] // Region
The resulting region is rendered with jagged edges.
![The rendered result of Example2][2]
How can this rendering be improved? I know that the rendered edges can not be infinitely sharp like in the mathematical world, but I think some improvement should be possible. Does anyone know how to achieve this? I am using Mathematica 11.1 on Windows.
Thanks for your help.
Maarten
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2018-02-1310_05_39-RegionIntersectionrenderingnotgood.nb_-WolframMathematica11.1.png&userId=307930
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2018-02-1310_06_27-RegionIntersectionrenderingnotgood.nb_-WolframMathematica11.1.png&userId=307930Maarten van der Burgt2018-02-13T09:17:38ZNarayana Cow Triangle Fractal
http://community.wolfram.com/groups/-/m/t/1286708
In 1356, Narayana posed a question in his book *Gaṇita Kaumudi*: "A cow gives birth to a calf every year. In turn, the calf gives birth to another calf when it is three years old. What is the number of progeny produced during twenty years by one cow?" This is now known as Narayana's cows sequence. The Narayana's cows sequence constant, **cow**=1.4655712318767680266567312252199391080255775684723, is the limit ratio between neighboring terms.
LinearRecurrence[{1, 0, 1}, {2, 3, 4}, 21]
NestList[Round[# Root[-1 - #1^2 + #1^3 &, 1]] &, 2, 20]
Either gives {2, 3, 4, 6, 9, 13, 19, 28, 41, 60, 88, 129, 189, 277, 406, 595, 872, 1278, 1873, 2745, 4023}. This turns out to be a good constant to use for a Rauzy fractal. The outer fractal triangle can be divided into copies of itself
r = Root[-1 - #1^2 + #1^3 &, 3]; iterations = 6;
cowed[comp_] := First /@ Split[Flatten[RootReduce[#[[1]] + (#[[2]] - #[[1]]) {0, -r^5, r^5 + 1, 1}] & /@ Partition[comp, 2, 1, 1], 1]];
poly = ReIm[Nest[cowed[#] &, #, iterations]] & /@ Table[N[RootReduce[r^({4, 1, 3, 5} + n) {1, 1, -1, 1}], 50], {n, 1,14}];
Graphics[{EdgeForm[{Black}], Gray, Disk[{0, 0}, .1], MapIndexed[{Hue[#2[[1]]/12], Polygon[#1]} &, poly]}]
![fractal Narayana Cow spiral ][1]
The ratio of areas for the triangles turns out to be **cow**. Try Area[Polygon[poly[[1]]]]/Area[Polygon[poly[[2]]]] and you'll see.
If you want to laser cut that, it's handy to get a single path.
cowpath[comp_] := First /@ Split[Flatten[RootReduce[#[[1]] + (#[[2]] - #[[1]]) {0, -r^5, r^5 + 1, 1}] & /@ Partition[comp, 2, 1], 1]];
path = ReIm[Nest[cowpath[#] &, N[Drop[Flatten[Table[r^({4, 1, 3} + n) {1, 1, -1}, {n, 1, 16}]], -1], 50], iterations]]; Graphics[{Line[path]}]
What else can be done with **cow**? With some trickier code I put together the pieces this way. Notice how order 5 spokes appear.
![Narayana cow fractal egg][2]
The opening gave an order 3 infinite spiral. Is there an order 5 infinite spiral? It turns out there is. Behold the **cow-nautilus**!
![cow-nautilus][3]
It can be made with the following code:
r=Root[-1-#1^2+#1^3&,3]; iterate=3;
cowed[comp_]:= First/@Split[Flatten[RootReduce[#[[1]]+(#[[2]]-#[[1]]){0,-r^5,r^5+1,1}]&/@Partition[comp,2,1,1],1]];
base={{r^10,r^7,-r^9,r^11},{-r^12,-r^9,r^11,-r^13},{r^8,r^5,-r^7,r^9},{-r^7,-r^4,r^6,-r^8}}+{-r^10,r^11,-r^6,r^4+r^8};
naut=RootReduce[Join[Table[base[[1]] (-r)^n,{n,0,-4,-1}],Flatten[Table[Drop[base,1](-r)^n,{n,-8,0}],1]]];
poly=ReIm[Nest[cowed[#]&,#,iterate]]&/@N[naut,50];
Graphics[{EdgeForm[{Black}],MapIndexed[{ColorData["BrightBands"][N[Norm[Mean[#1]]/2]],Polygon[#1]}&,poly]},ImageSize-> 800]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=fractalcowspiral.jpg&userId=21530
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=cowegg.jpg&userId=21530
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=cownautilus.jpg&userId=21530Ed Pegg2018-02-16T22:52:01Z[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:29Z3D Design in Mathematica: Generative Jewelry
http://community.wolfram.com/groups/-/m/t/1270499
*This article [originally appeared][1] The Mathematical Zorro blog*.
----------
![enter image description here][2]
I'll share a bit of Mathematica code that has helped me to add some ordered randomness to my art and jewelry. And we'll design a new piece of generative jewelry!
Before that, let me share something else I've been working on. In June of 2017 I gave myself a goal to share with the public each day one piece of jewelry I designed. Designing, refining, and posting took some effort, and I have completed my goal! In the process I designed some new jewelry that I really like, and I will be working over the coming months to develop them into coherent jewelry collections. I have been sharing on various social media accounts: @hanusadesign on [instagram][3], [facebook][4], [twitter][5], and [pinterest][6]. Be sure to follow me to see my latest work!
Now on to the Mathematica tutorial. What do I mean by ordered randomness? Compare the following sets of 100 random points:
![enter image description here][7]
While the points seem rather "random" in both sets, you can see that the points on the left often land rather close to each other while the points on the right are pretty regularly spaced. This last observation should tell you that the points on the right are not actually "random"! Indeed, the points on the left are chosen randomly using Mathematica's [RandomReal][8] command. (Even though the numbers are generated by a deterministic process in a computer program and thus inherently not completely random, we will say that pseudorandom is close enough for our purposes.) The command
ptlist = RandomReal[{-1, 1}, {100, 2}];
generates 100 pairs of real numbers that all fall between −1 and 1. On the other hand, the points on the right are chosen by a selection process in which we grow a list of points, starting with any point in the square. Then when we want to add a new point to the list, we generate a random point in the square and see if it is greater than a specified distance to any of the points already in our list. If so, it is added to our list; otherwise it is thrown out! Here is the code:
ptlist = {RandomReal[{-1, 1}, 2]};
While[Length[ptlist] < 100,
newpt = RandomReal[{-1, 1}, 2];
If[Min[Map[Norm[newpt - #] &, ptlist]] > .1,
ptlist = Append[ptlist, newpt]]]
Running the same code multiple times gives different sets of points.
## Generative jewelry
Let's take this idea and turn it into a nice piece of [generative jewelry][9], in that we don't actually know what it is going to look like before our program completes!
My goal is to create a piece of jewelry that is a collection of overlapping rings. We'll first generate a set of points and then construct rings centered at those points. We will work to complete three tasks to improve the aesthetic appeal of the final product:
1. The points should be lie in a circle instead of a square.
2. The points should be generously spaced.
3. The rings should be different sizes
For Task 1, we will specify a shape and ensure that each point that we consider is a member of that region. (Here we choose a circle, but you can easily modify it to be ANY region.) For Task 2, we will modify our selection process from above to add more distance between the points (radius .21 instead of .1) and have fewer points (50 instead of 100). By using our selection process, the rings won't overlap too awkwardly and it will be pleasing to the eye. The values I have chosen are purely by trial and error with a view toward making the proportions of the final product look good.
shape = Disk[{0, 0}, 1];
ptlist = {RandomReal[{-1, 1}, 2]};
While[! RegionMember[shape, ptlist[[1]]],
ptlist = {RandomReal[{-1, 1}, 2]}]
While[Length[ptlist] < 50, newpt = RandomReal[{-1, 1}, 2];
If[Min[Map[Norm[newpt - #] &, ptlist]] > .21
&& RegionMember[shape, newpt],
ptlist = Append[ptlist, newpt]]]
Graphics[{
{Lighter[Blue, .8], Rectangle[{-1, -1}, {1, 1}]},
{EdgeForm[{Black, Thick}], White, shape},
{Purple, Point[ptlist]}
}]
Notice that we have also ensured that the first point is also in the circular region. The result of this code looks like this:
![enter image description here][10]
Now we want to build a ring centered at each point. A basic torus that has an outer radius of .14 and tube radius of .03 looks like this:
torus[coords_] := Module[{thickness = .14, innerradius = .03},
ParametricPlot3D[{
( thickness + innerradius Cos[v]) Cos[u],
( thickness + innerradius Cos[v]) Sin[u],
innerradius Sin[v]} + Append[coords, 0],
{u, 0, 2 Pi}, {v, 0, 2 Pi}, Mesh -> None, PlotPoints -> 50]];
Mapping this function to the points in `ptlist` gives the following:
![enter image description here][11]
Now we need to attack Task 3, making the rings have different sizes. To do this we modify our torus function:
torus[coords_, thickness_] := Module[{innerradius = .03},
ParametricPlot3D[{
( thickness + innerradius Cos[v]) Cos[u],
( thickness + innerradius Cos[v]) Sin[u],
innerradius Sin[v]} + Append[coords, 0],
{u, 0, 2 Pi}, {v, 0, 2 Pi}, Mesh -> None, PlotPoints -> 50]];
and generate a set of random outer radii. I first chose the outer radii to be between .1 and .15, but when I displayed the rings, they were disconnected, which is not what we wanted
thicknesses = RandomReal[{.1, .15}, 50]
Show[MapThread[torus, {ptlist, thicknesses}], PlotRange -> All]
![enter image description here][12]
So I modified the the outer radii to be between .09 and .17. I definitely re-ran the code multiple times until I was happy with the final product. Here you go:
thicknesses = RandomReal[{.09, .17}, 50]
Show[MapThread[torus, {ptlist, thicknesses}], PlotRange -> All]
**Pro Tip**: Re-running the code always gives you a new arrangement. When you get a random arrangement that you like, you need to **save the data** that created it, so you can recreate it next time!
In essence, when working to create a piece of generative art, you impose randomness until you find something that you like, at which time you need to save this input so that this data will not change again — which seems to be the opposite of random! It was a revelation when I realized that adding randomness to my art involved saving the random data I generated.
## The Final Result
After exporting our final work to an STL, here is a rendering of our new piece of generative jewelry on Sketchfab:
[![enter image description here][13]][14]
And Shapeways gives the following beautiful rendering of [our pendant in Raw Bronze][15]:
[![enter image description here][18]][17]
The final 3D Printed pendant is the image at the top of the post.
And now you have the tools to make your own! If you have suggestions for how to modify this in an interesting way or for something else I should tackle, let me know. Happy New Year everyone!
[1]: http://blog.mathzorro.com/2017/07/generative.html
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-22at11.07.46AM.jpg&userId=20103
[3]: http://instagram.com/hanusadesign/
[4]: https://www.facebook.com/hanusadesign/
[5]: https://www.twitter.com/hanusadesign/
[6]: https://www.pinterest.com/hanusadesign/
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Mathematica_2017-06-26_21-45-59.png&userId=20103
[8]: https://reference.wolfram.com/language/ref/RandomReal.html
[9]: https://en.wikipedia.org/wiki/Generative_art
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=points.png&userId=20103
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=rings.png&userId=20103
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=disconnected.png&userId=20103
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-22at10.59.26AM.png&userId=20103
[14]: https://sketchfab.com/models/affe8a0915e14f55b8723ec3cd339092
[15]: http://shpws.me/OIrD
[16]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-22at11.02.37AM.png&userId=20103
[17]: http://shpws.me/OIrD
[18]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Shapeways.jpg&userId=1270503Christopher Hanusa2018-01-22T17:05:53Z[GIF] Small Changes (Hamiltonian cycle on the great rhombicosidodecahedron)
http://community.wolfram.com/groups/-/m/t/1282077
![Hamiltonian cycle on the great rhombicosidodecahedron][1]
**Small Changes**
This is the same idea as what I've been doing recently with [_Touch ’Em All_][2], [_All Day_][3], [_How Does That Work?_][4], and [_Throw_][5], but one dimension down: find a Hamiltonian cycle on the 1-skeleton of the [great rhombicosidodecahedron][6], normalize to get everything happening on the unit sphere, then stereographically project down to the plane.
First of all, we can extract the vertex coordinates from `PolyhedronData[]`, find a Hamiltonian cycle using `FindHamiltonianCycle[]`, and then re-order the vertices to be in the order they appear in the cycle:
sortedGRVertices =
Module[
{v = N[PolyhedronData["GreatRhombicosidodecahedron", "VertexCoordinates"]],
M, Γ, cycle},
Γ = PolyhedronData["GreatRhombicosidodecahedron", "SkeletonGraph"];
cycle = FindHamiltonianCycle[Γ];
v[[#[[1]] & /@ (cycle[[1]] /. UndirectedEdge -> List)]]
];
Now, I'm going to form spherical circles of radius $1/4$ the spherical distance between adjacent vertices and then stereographically project them down to the plane. Stereographic projection takes circles to circles, but unfortunately the stereographic image of the center is not the center of the stereographic image of the circle, which makes things complicated. Nonetheless, the function `ProjectedSphericalCircle[]` (defined below) inputs the center and radius of the circle up in the sphere and outputs a `Disk[]` object with the correct center and radius.
With that in hand, then, here's the code for an interactive version of the above animation:
DynamicModule[{r, θ, n, pts = Normalize /@ sortedGRVertices,
cols = RGBColor /@ {"#1DCED8", "#FAF9F0", "#F6490D", "#000249"}},
r = Min[DeleteCases[Flatten@Outer[VectorAngle, pts, pts, 1], 0.]];
n = Length[pts];
Manipulate[
θ = r unsmoothstep[t];
Graphics[
Table[
{Blend[cols[[;; -2]], Mod[i + 27 + t, n, 1]/(n - 1)],
ProjectedSphericalCircle[
RotationMatrix[-π/2, {0, 0, 1}].
RotationMatrix[θ, {pts[[i]], pts[[Mod[i + 1, Length[pts], 1]]]}].
pts[[i]],
r/4]},
{i, 1, Length[pts]}],
PlotRange -> 5, ImageSize -> 540, Background -> cols[[-1]]],
{t, 0, 1}]
]
Finally, then, is the definition of `ProjectedSphericalCircle[]`, which is quite ugly. I don't want to say too much about where it came from, other than that it was essentially the same procedure is described in the [post on _Inside_][7]: stereographically project an arbitrary circle on the sphere down to the plane and solve for the point where the normals to two distinct points intersect to find the center, and then of course the distance from either of those points to the center is the radius. Here's the definition:
ProjectedSphericalCircle[{x_, y_, z_}, r_] :=
If[Chop[x] == Chop[y] == 0. && Chop[z + 1] == 0,
Disk[{0, 0}, Tan[r/2]],
Disk[{(x Cos[r] + (x z Sin[r])/Sqrt[1 - z^2])/(
1 - z Cos[r] - ((-x^2 - y^2) Sin[r])/Sqrt[
1 - z^2]) + (Sqrt[2]
Sin[r] (x Sqrt[1 - z^2] (-1 + z Cos[r]) +
x (-1 + z^2) Sin[r]) ((
x Cos[r] - (y Sin[r])/Sqrt[1 - z^2])/(1 - z Cos[r]) - (
x Cos[r] + (x z Sin[r])/Sqrt[1 - z^2])/(
1 - z Cos[r] - ((-x^2 - y^2) Sin[r])/Sqrt[
1 - z^2])))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r] + (-1 + z^2) Sin[
r])^2 √(((-1 + z^2)^2 Sin[
r]^2 (3 - 4 z Cos[r] - Cos[2 r] + 2 z^2 Cos[2 r] +
4 Sqrt[1 - z^2] Sin[r] -
2 z Sqrt[1 - z^2] Sin[2 r]))/(-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r] + (-1 + z^2) Sin[r])^4) (-((2 Sqrt[2]
Sin[r] (y Sqrt[1 - z^2] (z - Cos[r]) +
x (-1 + z^2) Sin[r]))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r])^2 √(1/(-1 + z Cos[r])^4 (8 + 4 z^2 -
16 z Cos[r] - Cos[2 r] + 5 z^2 Cos[2 r] -
Cos[2 (π/2 + r)] +
z^2 Cos[2 (π/2 + r)]) Sin[r]^2))) + (Sqrt[2]
Sin[r] (x Sqrt[1 - z^2] (-1 + z Cos[r]) +
x (-1 + z^2) Sin[r]))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r] + (-1 + z^2) Sin[
r])^2 √(((-1 + z^2)^2 Sin[
r]^2 (3 - 4 z Cos[r] - Cos[2 r] + 2 z^2 Cos[2 r] +
4 Sqrt[1 - z^2] Sin[r] -
2 z Sqrt[1 - z^2] Sin[2 r]))/(-Sqrt[1 - z^2] +
z Sqrt[1 - z^2] Cos[r] + (-1 + z^2) Sin[r])^4)))), (
y Cos[r] + (y z Sin[r])/Sqrt[1 - z^2])/(
1 - z Cos[r] - ((-x^2 - y^2) Sin[r])/Sqrt[
1 - z^2]) + (2 Sqrt[2]
Sin[r] (y Sqrt[1 - z^2] (-1 + z Cos[r]) +
y (-1 + z^2) Sin[r]) ((
x Cos[r] - (y Sin[r])/Sqrt[1 - z^2])/(1 - z Cos[r]) - (
x Cos[r] + (x z Sin[r])/Sqrt[1 - z^2])/(
1 - z Cos[r] - ((-x^2 - y^2) Sin[r])/Sqrt[
1 - z^2])))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r] + (-1 + z^2) Sin[
r])^2 √(((-1 + z^2)^2 Sin[
r]^2 (12 - 16 z Cos[r] - 2 Cos[2 r] +
2 z^2 Cos[2 r] + (-2 + 6 z^2) Cos[2 r] +
16 Sqrt[1 - z^2] Sin[r] -
8 z Sqrt[1 - z^2] Sin[2 r]))/(-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r] + (-1 + z^2) Sin[r])^4) (-((2 Sqrt[2]
Sin[r] (y Sqrt[1 - z^2] (z - Cos[r]) +
x (-1 + z^2) Sin[r]))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r])^2 √(((-1 + z^2)^2 (8 - 16 z Cos[r] +
Cos[2 r] + (-2 + 6 z^2) Cos[2 r] -
Cos[2 (π/2 + r)] +
z^2 (4 - Cos[2 r] + Cos[2 (π/2 + r)])) Sin[
r]^2)/(-Sqrt[1 - z^2] +
z Sqrt[1 - z^2] Cos[r])^4))) + (2 Sqrt[2]
Sin[r] (x Sqrt[1 - z^2] (-1 + z Cos[r]) +
x (-1 + z^2) Sin[r]))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r] + (-1 + z^2) Sin[
r])^2 √(((-1 + z^2)^2 Sin[
r]^2 (12 - 16 z Cos[r] - 2 Cos[2 r] +
2 z^2 Cos[2 r] + (-2 + 6 z^2) Cos[2 r] +
16 Sqrt[1 - z^2] Sin[r] -
8 z Sqrt[1 - z^2] Sin[2 r]))/(-Sqrt[1 - z^2] +
z Sqrt[1 - z^2] Cos[r] + (-1 + z^2) Sin[r])^4))))},
Abs[((x Cos[r] - (y Sin[r])/Sqrt[1 - z^2])/(1 - z Cos[r]) - (
x Cos[r] + (x z Sin[r])/Sqrt[1 - z^2])/(
1 - z Cos[r] - ((-x^2 - y^2) Sin[r])/Sqrt[
1 - z^2]))/(-((2 Sqrt[2]
Sin[r] (y Sqrt[1 - z^2] (z - Cos[r]) +
x (-1 + z^2) Sin[r]))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r])^2 √(((-1 + z^2)^2 (8 - 16 z Cos[r] +
Cos[2 r] + (-2 + 6 z^2) Cos[2 r] -
Cos[2 (π/2 + r)] +
z^2 (4 - Cos[2 r] + Cos[2 (π/2 + r)])) Sin[
r]^2)/(-Sqrt[1 - z^2] +
z Sqrt[1 - z^2] Cos[r])^4))) + (2 Sqrt[2]
Sin[r] (x Sqrt[1 - z^2] (-1 + z Cos[r]) +
x (-1 + z^2) Sin[r]))/((-Sqrt[1 - z^2] +
z Sqrt[1 - z^2]
Cos[r] + (-1 + z^2) Sin[
r])^2 √(((-1 + z^2)^2 Sin[
r]^2 (12 - 16 z Cos[r] - 2 Cos[2 r] +
2 z^2 Cos[2 r] + (-2 + 6 z^2) Cos[2 r] +
16 Sqrt[1 - z^2] Sin[r] -
8 z Sqrt[1 - z^2] Sin[2 r]))/(-Sqrt[1 - z^2] +
z Sqrt[1 - z^2] Cos[r] + (-1 + z^2) Sin[r])^4)))]]]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=GRproj10Lr.gif&userId=610054
[2]: http://community.wolfram.com/groups/-/m/t/1263478
[3]: http://community.wolfram.com/groups/-/m/t/1265322
[4]: http://community.wolfram.com/groups/-/m/t/1269759
[5]: http://community.wolfram.com/groups/-/m/t/1273027
[6]: http://mathworld.wolfram.com/GreatRhombicosidodecahedron.html
[7]: http://community.wolfram.com/groups/-/m/t/1260753Clayton Shonkwiler2018-02-09T23:27:22Z