# [GIF] Home on the Range (Rotating minimal 7_7 on the BCC lattice)

Posted 1 year ago
3529 Views
|
3 Replies
|
11 Total Likes
| Home on the RangeContinuing the series (1, 2, 3), this time with a minimal $7_7$ knot on the body-centered cubic lattice. Instead of viewing the projection of the knot as a bunch of balls connected by sticks, I'm filling it in with a solid color. As per the Polygon conventions, the points in the plane for which any path to the unbounded region crosses the boundary an odd number of times are colored dark purple, and the rest of the points in the plane are colored light grey.As before, the coordinates are grabbed from Andrew Rechnitzer's site: bcc77 = Standardize[ Import["https://www.math.ubc.ca/~andrewr/knots/data/BCC77.dat"], Mean, 1 &]; Thanks to @J. M. for various code improvement suggestions, especially for the function $t \mapsto \frac{t^3}{1-3t(1-t)}$. DynamicModule[{p, q, b, n, ?, pl, cols = RGBColor /@ {"#621295", "#e3e7f1"}}, Manipulate[ ? = 2?/3 (#^3/(1 - 3 # (1 - #))) &[Mod[t, 1]]; Which[t < 1 || t == 2, {p, q} = {{-1, 0, 0}, {0, 0, 1}}; {n, b} = {p, q}.RotationMatrix[?, {-1, -1, 1}];, 1 <= t < 2, {p, q} = {{0, 0, 1}, {0, -1, 0}}; {n, b} = {p, q}.RotationMatrix[?, {1, -1, 1}]; ]; pl = bcc77.Transpose[{Cross[b, n], b}]; Graphics[{Thickness[.005], JoinForm["Round"], cols[], CapForm["Round"], Polygon[pl]}, ImageSize -> 540, PlotRange -> 4, Background -> cols[[-1]]], {t, 0, 2}] ] Answer
3 Replies
Sort By:
Posted 1 year ago
 Looks nice!Just to be ornery, I came up with a variation that combines my "rational smoothstep" with spherical linear interpolation ("slerp"): DynamicModule[{b, n, u, ? = N[2 ?/3] , cols = RGBColor /@ {"#621295", "#e3e7f1"}}, Manipulate[u = (#^3/(1 - 3 # (1 - #))) &[Mod[t, 1]]; {n, b} = Which[t < 1 || t == 2, {{-1, 0, 0}, {0, 0, 1}} Sin[? (1 - u)] + {{0, 0, 1}, {0, -1, 0}} Sin[? u], 1 ? t < 2, {{0, 0, 1}, {0, -1, 0}} Sin[? (1 - u)] + {{1, 0, 0}, {0, 0, 1}} Sin[? u]]/Sin[?]; Graphics[{cols[], Polygon[bcc77.Transpose[{Cross[b, n], b}]]}, ImageSize -> 540, PlotRange -> 4, Background -> cols[[-1]]], {t, 0, 2}]]  Answer
Posted 1 year ago - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming, and consider contributing your work to the The Notebook Archive! Answer
Posted 1 year ago
 Wonderful work! So newcomers to knot theory can appreciate deeper your art here are some basic visuals of what $7_7$ knot is: KnotData[{7, 7}, #] & /@ {"Image", "KnotDiagram"}  Answer