Message Boards Message Boards

[GIF] Triakis (Cross sections of the triakis icosahedron)

Cross sections of the triakis icosahedron

Triakis

Another in my collection of animations given by taking parallel cross sections of some shape, in this case the triakis icosahedron.

Again, I'm using my function for getting cross sections of convex polytopes:

slices[edges_, vec_, plotrange_] := 
 Module[{projector, pedges, n, times, positions, v},
   projector = Orthogonalize[NullSpace[{vec}]];
   pedges[t_] := (1 - t) #[[1]] + t #[[2]] & /@ edges;
   n = Length[pedges[.5]];
   times = 
    Table[NSolve[{pedges[t][[i]].vec == #, 0 <= t <= 1}, t], {i, 1, 
      n}];
   positions = Flatten[Position[times, a_ /; a != {}, 1]];
   v = Table[
     pedges[t][[positions[[i]]]] /. 
      Flatten[times[[positions[[i]]]], 1], {i, 1, 
      Length[positions]}];
   ConvexHullMesh[projector.# & /@ v, PlotRange -> plotrange, 
    PlotTheme -> "Polygons"]
   ] &

And then here's the code for producing the animation (note that most of the nastiness in the definition of θ is just coming from exact expressions for the heights of the vertices of Mathematica's standard triakis icosahedron):

DynamicModule[{polyhedron, sliceaxis, plotrange, imageSize, n, cols, 
  edges, θ, pol},
 polyhedron = "TriakisIcosahedron";
 sliceaxis = {0, 0, 1};
 plotrange = 3;
 imageSize = 540;
 n = 400;
 cols = RGBColor /@ {"#E84A5F", "#FECEA8", "#2A363B"};
 edges = PolyhedronData[polyhedron, "VertexCoordinates"][[#]] & /@ 
   PolyhedronData[polyhedron, "Edges"][[2, 1]];
 Manipulate[
  θ = 
   Sqrt[5/8 + 11/(8 Sqrt[5])] + 
    1/2 (-Sqrt[5/8 + 11/(8 Sqrt[5])] + 
       Root[1 - 100 #1^2 + 80 #1^4 &, 1]) - 
    1/2 (Sqrt[5/8 + 11/(8 Sqrt[5])] - 
       Root[1 - 100 #1^2 + 80 #1^4 &, 1]) Cos[s]; 
  Graphics[{Style[GraphicsComplex[pol = MeshCells[#, 2][[1, 1]];
        Prepend[Append[#, First[#]] &[MeshCoordinates[#]], {0, 0}], 
        Polygon[Prepend[Append[#, First[#]] &[1 + # & /@ pol], 1]], 
        VertexColors -> 
         Prepend[ConstantArray[cols[[1]], Length[pol] + 1], 
          cols[[2]]]], Antialiasing -> True] &[
     slices[edges, sliceaxis, plotrange][θ]]}, 
   PlotRange -> plotrange, ImageSize -> imageSize, 
   Background -> cols[[3]]], {s, 0, π}]
 ]

I would love to know of a better way to produce the gradient inside the polygon. As you can see, I created a secret extra vertex in the center and then used VertexColors, is there an easier way to put gradients inside polygons which isn't vertex-based (for example, creating a gradient texture and using VertexTextureCoordinates is also vertex-based, which isn't really what I want).

2 Replies

Beautiful, @Clayton Shonkwiler, thank you! And let me remind everyone, that triakis icosahedron is looked up simply using CTRL+= as

enter image description here

enter image description here

And you can even get all properties like

enter image description here

among which there are these nice nets:

enter image description here

POSTED BY: EDITORIAL BOARD

enter image description here - another post of yours has been selected for the Staff Picks group, congratulations !

We are happy to see you at the tops of the "Featured Contributor" board. Thank you for your wonderful contributions, and please keep them coming!

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

Group Abstract Group Abstract