Posts Tagged ‘Auto

24
Apr
07

Homotopy

This began as an attempt to animate a similar-looking structure to Bathsheba Grossmanâ€™s beautiful Quin Pendant Lamp. Depending on your point of view, this knotted structure can be seen as a dodecahedron with a hole over each edge, or an icosahedron with a hole over each vertex, or an icosahedron with a hole over each edge, or a rhombic triacontahedron with a hole over each face. The left animation shows a homotopy that continuously maps the structure into a sphere with 30 holes. The boundary of each hole loops over itself twice and links with 6 others.

Here is some Mathematica code:

```(* runtime: 0.1 second *)
<< Graphics`Shapes` ; alpha = ArcCos[-Sqrt[5]/5];
surface = {{{0.11, 0.35, 1}, {0.16, 0.33, 1}, {0.23, 0.35, 0.99}, {0.3,
0.38, 0.96}, {0.35, 0.43, 0.9}, {0.29, 0.42, 0.8}, {0.22, 0.37,0.7},
{0.14, 0.34, 0.62}, {0.078, 0.296, 0.585}}, {{0, 0, 1}, {0.13, 0.09,
1}, {0.29, 0.22, 0.99}, {0.4, 0.33, 0.95}, {0.41, 0.45, 0.88}, {0.31,
0.47, 0.77}, {0.2, 0.43, 0.65}, {0.08, 0.4, 0.56}, {-0.019, 0.398,
0.526}}, {{0.36, 0, 1}, {0.39, 0.11, 1}, {0.45, 0.23,0.99}, {0.49,
0.35, 0.95}, {0.47, 0.45, 0.86}, {0.36, 0.52, 0.73}, {0.22, 0.5, 0.59},
{0.13, 0.48, 0.48}, {0.07, 0.489, 0.437}}};
arm = Map[Polygon[Flatten[#, 1][[{1, 2, 4, 3}]]] &, Partition[surface, {2, 2}, 1], {2}];
face = Table[RotateShape[Graphics3D[arm], 0, 0, psi][[1]], {psi, 0, 1.6Pi, 0.4Pi}];
Show[Graphics3D[{face, RotateShape[face, 0, Pi, 0],
Table[{RotateShape[face, 0, Pi - alpha, psi + Pi/5], RotateShape[face,
Pi/5, alpha, psi]}, {psi, 0, 1.6Pi, 0.4Pi}]}]]```

Welcome !

You will find here some of my favorite hobbies and interests, especially science and art.

I hope you enjoy it!

Subscribe to the RSS feed to stay informed when I publish something new here.

I would love to hear from you! Please feel free to send me an email : bugman123-at-gmail-dot-com