# [GIF] Master Control Program (Minimal 7_4 knot on the simple cubic lattice)

Posted 1 year ago
1859 Views
|
2 Replies
|
7 Total Likes
|
 Master Control ProgramContinuing the series of minimal lattice knots (1, 2, 3, 4), but now back to the simple cubic lattice with the $7_4$ knot (a.k.a. the endless knot from Buddhism). Here's a more standard view of the $7_4$: KnotData[{7, 4}, #] & /@ {"Image", "KnotDiagram"} Once again, we're grabbing the coordinates of this minimal lattice knot from Andrew Rechnitzer's page and mean-centering: sc74 = Standardize[Import["https://www.math.ubc.ca/~andrewr/knots/data/SC74.dat"], Mean, 1 &]; To get the background gradient I'm using RadialGradientImage, which renders very slowly. If you want a responsive Manipulate, delete the Overlay and the RadialGradientImage, and in the Graphics replace Background -> None with Background -> cols[[-2]]. DynamicModule[{p, q, b, n, ?, pl, cols = RGBColor /@ {"#cdffeb", "#009f9d", "#07456f", "#0f0a3c"}}, Manipulate[ ? = ArcCos[-(1/3)] (#^3/(1 - 3 # (1 - #))) &[Mod[t, 1]]; Which[t < 1 || t == 4, {p, q} = Normalize /@ {{1, 1, 1}, {1, 0, -1}}; {n, b} = {p, q}.RotationMatrix[-?, {-1, 0, 1}];, 1 <= t < 2, {p, q} = Normalize /@ {{-1, 1, -1}, {1, 0, -1}}; {n, b} = {p, q}.RotationMatrix[-?, {0, 1, 1}];, 2 <= t < 3, {p, q} = Normalize /@ {{-1, -1, 1}, {-1, 0, -1}}; {n, b} = {p, q}.RotationMatrix[- ?, {1, 0, 1}];, 3 <= t < 4, {p, q} = Normalize /@ {{1, -1, -1}, {-1, 0, -1}}; {n, b} = {p, q}.RotationMatrix[- ?, {0, -1, 1}]; ]; pl = sc74.Transpose[{Cross[b, n], b}]; Overlay[ {RadialGradientImage[cols[[2 ;;]], {540, 540}], Graphics[ {EdgeForm[ Directive[Thickness[.025], JoinForm["Round"], cols[[1]]]], FaceForm[None], Polygon[pl]}, ImageSize -> 540, PlotRange -> 4, Background -> None]} ], {t, 0, 4}] ] 
2 Replies
Sort By:
Posted 1 year ago
 Since the background is a fixed thing and not being actively updated, you can put the initialization in DynamicModule[]; thus, you can do something like DynamicModule[{p, q, b, n, ?, pl, col = RGBColor["#cdffeb"], bg = RadialGradientImage[RGBColor /@ {"#009f9d", "#07456f", "#0f0a3c"}, {540, 540}]}, Manipulate[(* stuff *) Overlay[{bg, Graphics[{EdgeForm[Directive[Thickness[.025], JoinForm["Round"], col]], FaceForm[], Polygon[pl]}, ImageSize -> 540, PlotRange -> 4]}], {t, 0, 4}]] Yet another alternative that avoids Overlay[] would be to use a textured polygon as background. To do that, you can replace the last line inside the Manipulate[] with Graphics[(* stuff *), ImageSize -> 540, PlotRange -> 4, Prolog -> {Texture[bg], Polygon[{Scaled[{0, 0}], Scaled[{1, 0}], Scaled[{1, 1}], Scaled[{0, 1}]}, VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}]