# [GIF] Minimal (Rotating minimal lattice trefoil knot)

Posted 1 year ago
3905 Views
|
4 Replies
|
12 Total Likes
| MinimalThis shows the trefoil knot lying on the simple cubic lattice with the fewest possible number of edges (it's a theorem of Yuanan Diao that the lattice stick number of the trefoil is 24), rotated, and projected to the plane. The 3D vertex locations are in KnotPlot. At least in the MacOS version of KnotPlot, the data is contained in the app bundle at /Applications/KnotPlot/KnotPlot.app/Contents/Resources/special/mscl/3.1; if you don't have KnotPlot installed, you can download the data by going to https://knotplot.com/download/ and clicking the link to download kpdist.tar.gz. If you do that and then unzip to get a directory called kpsdist, the following commands will import the vertices and mean center: lattice31 = Import["kpdist/special/mscl/3.1", "Table"]; lattice31 = lattice31 - Table[Mean[lattice31], {Length[lattice31]}]; As usual for animations where I want to smoothly stop and start a motion, I'm going to use the smootheststep function: smootheststep[t_] := -20 t^7 + 70 t^6 - 84 t^5 + 35 t^4; Here, then, is the Manipulate for the above animation (the giant obnoxious Which is to switch between different axis rotations, which I obviously could have made a little cleaner with some extra work): DynamicModule[{p, q, a, b, n, M, ?, pl, cols = RGBColor /@ {"#fd5f00", "#05004e", "#fbfaf1"}}, Manipulate[ Which[t < 1 || t == 4, {p, q} = RotationMatrix[ArcTan[1/Sqrt]].{Normalize[{1, 1, 0}], {0, 0, 1}}; ? = -(ArcTan[1/Sqrt] + ?/2) smootheststep[Mod[t, 1]]; {n, b} = RotationMatrix[?].{p, q};, 1 <= t < 2, {p, q} = {{0, 0, 1}, {-(1/Sqrt), -(1/Sqrt), 0}}; ? = (? - ArcTan[Sqrt[23 - 16 Sqrt]]) smootheststep[Mod[t, 1]]; {n, b} = RotationMatrix[-?, N@{Sqrt[1/17 (5 + 2 Sqrt)], Sqrt[1/17 (7 - 4 Sqrt)], Root[1 - 10 #1^2 + 17 #1^4 &, 1]}].# & /@ {p, q};, 2 <= t < 3, {p, q} = {{-1, 0, 0}, {0, 0, 1}}; ? = 3 ?/4 smootheststep[Mod[t, 1]]; {n, b} = RotationMatrix[?].{p, q}, 3 <= t, {p, q} = {{1/Sqrt, 0, -(1/Sqrt)}, {-(1/Sqrt), 0, -(1/Sqrt)}}; ? = (? - ArcCot[(3 - 2 Sqrt + 2 Sqrt + Sqrt)/Sqrt[ 13 - 4 Sqrt + 2 Sqrt]]) smootheststep[Mod[t, 1]]; {n, b} = RotationMatrix[-?, N@{Root[1 - 156 #1^2 + 1670 #1^4 - 5148 #1^6 + 4801 #1^8 &, 1], Root[1 - 52 #1^2 + 870 #1^4 - 5044 #1^6 + 4801 #1^8 &, 2], (2 + Sqrt)/Sqrt[ 94 - 48 Sqrt + 48 Sqrt - 32 Sqrt]}].# & /@ {p, q}; ]; a = Cross[b, n]; M = {a, b}; pl = M.# & /@ lattice31; Graphics[ {Thickness[.004], cols[], Line[Append[#, First[#]] &[pl]], FaceForm[cols[[-1]]], EdgeForm[Directive[Thickness[.004], cols[]]], Disk[M.#, .05] & /@ Sort[lattice31, n.#1 > n.#2 &]}, ImageSize -> 540, PlotRange -> 2.2, Background -> cols[[-1]]], {t, 0, 4}] ] Answer
4 Replies
Sort By:
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
 For people who don't want to download software just to get the needed points for the knot: lattice31 = AnglePath3D[{19/24, 4/3, 11/8}, {{0, ?/2}, {0, 0}, {-?/2, 0}, {0, ?/2}, {0, 0}, {0, -?/2}, {-?/2, 0}, {?/2, 0}, {0, -?/2}, {0, 0}, {0, -?/2}, {0, 0}, {0, -?/2}, {0, ?/2}, {?/2, 0}, {0, 0}, {?/2, 0}, {0, 0}, {?/2, 0}, {0, 0}, {0, 0}, {0, ?/2}, {?/2, 0}}]; As for the main code itself: the standard advice of replacing M.# & /@ pts with pts.Transpose[M] and RotationMatrix[-?, axis].# & /@ {p, q} with {p, q}.RotationMatrix[?, axis] applies. ;) Answer
Posted 1 year ago
 As for the main code itself: the standard advice of replacing M.# & /@ pts with pts.Transpose[M] and RotationMatrix[-?, axis].# & /@ {p, q} with {p, q}.RotationMatrix[?, axis] applies. ;) Yeah, I know. I think I've never quite accepted the reality that individual vectors may as well be column vectors (in terms of how matrix multiplication works), but vectors in lists are definitely row vectors. Answer
Posted 1 year ago
 For better or for worse, Mathematica's matrices (or list of lists, however your preference) are row-oriented. I admit that it also took me some time to adjust my conventional mental images of linear algebra to adapt them to programming in Mathematica. Answer