[GIF] Circle - Gecko - triangular tiling transformation inspired by Escher

Posted 2 years ago
5388 Views
|
9 Replies
|
31 Total Likes
|
 Inspired by the work of the Frisian artist M.C. Escher, I decided to make this little animation:The code is nothing more than linear interpolation between sets of points: SetDirectory[NotebookDirectory[]]; p1 = {{0.,0.},{0.0678,0.054200000000000005},{0.1336,0.09570000000000001},{0.1831,0.1257},{0.2398,0.1714},{0.26780000000000004,0.20850000000000002},{0.2528,0.2606},{0.22760000000000002,0.3084},{0.2117,0.3584},{0.21930000000000002,0.41000000000000003},{0.24550000000000002,0.4595},{0.28500000000000003,0.5056},{0.34,0.48260000000000003},{0.3935,0.45320000000000005},{0.4305,0.43760000000000004},{0.43820000000000003,0.39840000000000003},{0.4303,0.3698},{0.3831,0.3678},{0.3552,0.3683},{0.3925,0.33180000000000004},{0.4148,0.2927},{0.4339,0.2671},{0.49720000000000003,0.2947},{0.5356000000000001,0.33380000000000004},{0.5789000000000001,0.3659},{0.558,0.4297},{0.5141,0.48090000000000005},{0.5,0.5},{0.5,0.5},{0.4859,0.5191},{0.442,0.5703},{0.42110000000000003,0.6341},{0.46440000000000003,0.6662},{0.5028,0.7053},{0.5661,0.7329},{0.5852,0.7073},{0.6075,0.6682},{0.6448,0.6317},{0.6169,0.6322},{0.5697,0.6302},{0.5618000000000001,0.6016},{0.5695,0.5624},{0.6065,0.5468000000000001},{0.66,0.5174},{0.7150000000000001,0.4944},{0.7545000000000001,0.5405},{0.7807000000000001,0.5900000000000001},{0.7883,0.6416000000000001},{0.7724000000000001,0.6916},{0.7472000000000001,0.7394000000000001},{0.7322000000000001,0.7915000000000001},{0.7602,0.8286},{0.8169000000000001,0.8743000000000001},{0.8664000000000001,0.9043},{0.9322,0.9458000000000001},{1.,1.}}; p2 = {{1.,1.},{1.0396177978506647,0.8923346254845568},{1.0553148607198288,0.8165562085782169},{1.0612803330660763,0.7422415758850744},{1.0593972739777413,0.6855070651494309},{1.0410889377634256,0.6295007686706042},{0.9985803499841852,0.5851973901977947},{0.9483041434655642,0.5486542747648014},{0.9100397943346402,0.495994821587507},{0.8886126415052703,0.4220994637695018},{0.8802712781999131,0.3410911444732952},{0.9107680085914569,0.2922860778674355},{0.944118750413758,0.23431580960507237},{0.9891650545425124,0.1782359561306078},{1.0249726000191246,0.2133888443460414},{1.0610964405769812,0.25639761969562114},{1.0125267563571634,0.29612575303974287},{0.9819491132704178,0.3427388211755879},{1.042685124568772,0.3779726220862235},{1.0923875865214163,0.4314412022155367},{1.110695922735732,0.3701240906516413},{1.139236037043303,0.307894872341834},{1.1672759637805352,0.24281899830083345},{1.190159545123539,0.19293999955865795},{1.1550875696033072,0.15058588147025714},{1.1048113630846865,0.1033990687684352},{1.0520783529117537,0.05681542343084531},{1.,0.}}; rf = RotationTransform[\[Pi]/2, {1, 0}]; p3 = Reverse[rf /@ p2]; colors = {RGBColor[0.9280877328700329, 0.8058790727091572, 0.41541817087124444],RGBColor[0.5551256603319519, 0.6745729914926235, 0.40725444158653856]}; ClearAll[GetLines, MakeScene] GetLines[\[Beta]_] := Module[{\[Alpha], goal1, goal2, goal3, goal, lenp}, If[0 <= \[Beta] <= 0.5, \[Alpha] = 2 \[Beta]; lenp = Length[p1] + Length[p2] + Length[p3]; goal = CirclePoints[{0.66, 0.33}, {0.33, 3.97}, lenp]; {goal1, goal2, goal3} = FoldPairList[TakeDrop, goal, (Length /@ {p3, p2, p1})][[{3, 2, 1}]]; Polygon[Join @@ {\[Alpha] p1 + (1 - \[Alpha]) Reverse[ goal1], \[Alpha] p2 + (1 - \[Alpha]) Reverse[ goal2], \[Alpha] p3 + (1 - \[Alpha]) Reverse[ goal3]}] , \[Alpha] = 2 (\[Beta] - 0.5); goal1 = Subdivide[0, 1, Length[p1] - 1]; goal1 = {goal1, goal1}\[Transpose]; goal2 = Subdivide[1, 0, Length[p2] - 1]; goal2 = Thread[{1, goal2}]; goal3 = Subdivide[1, 0, Length[p3] - 1]; goal3 = Thread[{goal3, 0}]; Polygon[Join @@ {(1 - \[Alpha]) p1 + \[Alpha] goal1, (1 - \[Alpha]) p2 + \ \[Alpha] goal2, (1 - \[Alpha]) p3 + \[Alpha] goal3}] ] ] MakeScene[\[Alpha]_] := Module[{in, shape}, in = GetLines[\[Alpha]]; shape = {in, Rotate[in, \[Pi], {0.5, 0.5}]}; shape = Riffle[colors, shape]; shape = Rotate[shape, #, {0, 0}] & /@ Range[0, 3 \[Pi]/2, \[Pi]/2]; shape = Translate[shape, Tuples[{-2, 0, 2}, 2]]; shape ] To animate it using manipulate use: Manipulate[Graphics[MakeScene[\[Tau]], PlotRange -> 2.5], {\[Tau], 0, 1}] And to output the animation I used: n=150; ClearAll[Nonlineartime] Nonlineartime[t_]:=0.5LogisticSigmoid[25(t-0.2)]+0.5LogisticSigmoid[25(t-0.75)] Plot[Nonlineartime[t],{t,0,1}] ts=Table[Nonlineartime[t],{t,Subdivide[0.0,1,n]}]; ts[[{1,-1}]]={0.0,1.0}; imgs=Table[Rasterize[Graphics[MakeScene[t],PlotRange->2.5,ImageSize->400],"Image"],{t,ts}]; Export["geckotransform.gif",imgs~Join~Reverse[imgs],"DisplayDurations"->0.03] 
9 Replies
Sort By:
Posted 2 years ago
 Spectacular! Now I finally understand what process Escher was using to make these tilings. Thank you!
Posted 2 years ago
Posted 2 years ago
 - another post of yours has been selected for the Staff Picks group, congratulations !We are happy to see you at the top of the "Featured Contributor" board. Thank you for your wonderful contributions, and please keep them coming!
Posted 2 years ago
 Very nice! The simplicity of the idea makes it all the more appealing.
Posted 2 years ago
 As others mentioned it is great and instructional. It look like an XKCD version too...
Posted 1 year ago
 Hi Sander,Very cool ! I play a little bit your code, export a image format. ImageRotate[ImageAssemble[Partition[Image@Table[Graphics[MakeScene[\[Tau]],PlotRange->{{-2.5,2.5},{0,2}}],{\[Tau],0,1,.05}],1]],Pi/2] It looks more like Escher's Metamorphosis style in his time ( without internet and GIF). http://www.mcescher.com/gallery/transformation-prints/
Posted 1 year ago
 That is really neat! Thanks for sharing! Now I feel I should do more of these kind of transformations!