Message Boards

Posted 4 years ago
4333 Views
|
|
7 Total Likes
|
 Anything GoesIt's an obvious but kind of cool fact that every quadrilateral tiles the plane. Building on some ideas from Cut the Knot, I decided to write a function which would, given the edges of a quadrilateral (as vectors), produce a tessellation. Here's what I ended up with: BasicBlock[edges_] := Module[{n}, n = Length[edges]; Table[Accumulate[(-1)^i RotateRight[edges, i]], {i, 0, n - 1}] ]; QuadTilingBasis[edges_] := {edges[[2]] - edges[[4]], edges[[3]] - edges[[1]]}; EdgesToTessellation[edges_, numx_, numy_] := Module[{basis}, basis = QuadTilingBasis[edges]; Table[Polygon /@ (x*basis[[1]] + y*basis[[2]] + # & /@ # & /@ BasicBlock[edges]), {x, -(numx - 1)/2, (numx - 1)/ 2}, {y, -(numy - 1)/2, (numy - 1)/2}] ]; Given that, I used some general machinery that I've discussed before (1, 2, 3) for generating random polygons and finding geodesics in polygon space to generate various 1-parameter families of quadrilaterals (and, hence, tessellations). Here are the necessary bits of that code: ToReal[z_] := {Re[z], Im[z]}; ToComplex[{x_, y_}] := x + I y; FrameToEdges[frame_] := ToReal[ToComplex[#]^2] & /@ Transpose[frame]; QuadFrameToTessellation[frame_, numx_, numy_] := EdgesToTessellation[FrameToEdges[frame], numx, numy]; ProjectionBasis[{A_, B_}, {C_, D_}] := Normalize[#] & /@ Eigenvectors[ Transpose[Transpose[{A, B}].{A, B}.Transpose[{C, D}].{C, D}], 2]; PlaneGeo[{A_, B_}, {C_, D_}, t_] := Module[{a, b, c, d, cPerp, dPerp, dist1, dist2}, {a, b} = ProjectionBasis[{C, D}, {A, B}]; {c, d} = ProjectionBasis[{A, B}, {C, D}]; {cPerp, dPerp} = {Normalize[c - (c.a)*a], Normalize[d - (d.b)*b]}; dist1 = ArcCos[a.c]; dist2 = ArcCos[b.d]; {Cos[t*dist1]*a + Sin[t*dist1]*cPerp, Cos[t*dist2]*b + Sin[t*dist2]*dPerp} ]; Eventually, I found two elements of the Stiefel manifold that produced an interesting family of tessellations: frame1 = {{-0.21728090898823724, -0.08834582559466465, 0.7450486536045761, 0.6244089408802944}, {-0.7224486073877968, 0.44620730863225605, -0.4229311116667767, 0.3163800281163406}}; frame2 = {{0.42870301121644105, 0.38283874197110207, -0.633804812205533, -0.5176289074665839}, {-0.6547467745123633, 0.7145404849942669, 0.14903954331161623, -0.19627982855932777}}; And then, finally, here's the code that produces the above animation: Module[{cols}, cols = RGBColor /@ {"#00C3FF", "#F46188", "#3B475E"}; Animate[Graphics[{FaceForm[None], EdgeForm[ Directive[JoinForm["Round"], Thickness[.005], Blend[cols[[;; 2]], Haversine[t]]]], QuadFrameToTessellation[ PlaneGeo[frame1, frame2, .96 Haversine[t]], 10, 8]}, PlotRange -> 2, ImageSize -> 540, Background -> Last[cols]], {t, 0, π}, AnimationDirection -> ForwardBackward] ]