# [GIF] Coalesce (Deforming an isometric pattern)

Posted 3 years ago
6740 Views
|
9 Replies
|
20 Total Likes
|
 CoalesceContinuing with the theme of selectively breaking and re-forming a tiling pattern (1, 2, 3), though this time without any rotation.Here's the (very slow) code: DynamicModule[{BasicTileCoords, f, cols, centerpoint, ψ, layering}, BasicTileCoords = {{0, -1}, {0, 0}, {Sqrt[3]/2, 1/2}, {Sqrt[3]/2, 0}, {Sqrt[3]/4, -1/4}, {Sqrt[3]/4, -3/4}}; cols = ColorData["BlueGreenYellow"] /@ Range[1, 0, -1/4]; f = 3 Piecewise[{{0, # < 0}, {1/2 - 1/2 Cos[#], 0 <= # < π}, {1, # >= π}}] &; layering = Append[Riffle[Reverse[Range[5]], -Reverse[Range[5]]], 0]; Manipulate[ Graphics[{EdgeForm[Directive[JoinForm["Round"], cols[[4]], Thickness[.006]]], Table[ {centerpoint = {3 Sqrt[3]/4 i, 3/2 j + (-1)^i*3/8}; ψ = f[θ - π/(3 Sqrt[7]) Norm[centerpoint - {0, 3/8}]]; FaceForm[Directive[cols[[t]]]], Polygon[centerpoint + # & /@ (RotationMatrix[2 π t/3].(ψ {Sqrt[3]/4, -1/4} + #) & /@ BasicTileCoords)]}, {j, layering}, {i, layering}, {t, 1, 3}]}, PlotRange -> {{-5, 5}, {-5 + 3/8, 5 + 3/8}}, Background -> cols[[5]], ImageSize -> 540], {θ, 0., 2 π}] ] 
9 Replies
Sort By:
Posted 3 years ago
 If you pre-compute everything except for the bits that depend upon the Manipulate variable, it gets much faster. This code is not so pretty. I didn't try to make the most elegant refactoring that does precomputation...just one that I could easily refactor starting from your code. But, on my computer, the slider pretty much works in real time. DynamicModule[{BasicTileCoords, f, cols, centerpoint, ψ, layering, pts1, pts2, pts3, n}, BasicTileCoords = {{0, -1}, {0, 0}, {Sqrt[3]/2, 1/2}, {Sqrt[3]/2, 0}, {Sqrt[3]/4, -1/4}, {Sqrt[3]/4, -3/4}}; cols = ColorData["BlueGreenYellow"] /@ Range[1, 0, -1/4]; f = 3 Piecewise[{{0, # < 0}, {1/2 - 1/2 Cos[#], 0 <= # < π}, {1, # >= π}}] &; layering = Append[Riffle[Reverse[Range[5]], -Reverse[Range[5]]], 0]; {pts1, pts2, pts3} = Table[centerpoint = {3 Sqrt[3]/4 i, 3/2 j + (-1)^i*3/8}; ψ = f[n - π/(3 Sqrt[7]) Norm[centerpoint - {0, 3/8}]]; N[centerpoint + # & /@ (RotationMatrix[ 2 t π /3].(ψ {Sqrt[3]/4, -1/4} + #) & /@ BasicTileCoords)], {t, 1, 3}, {j, layering}, {i, layering}]; Manipulate[ Graphics[{EdgeForm[ Directive[JoinForm["Round"], cols[[4]], Thickness[.006]]], {{FaceForm[Directive[cols[[1]]]], Polygon[Dynamic[Flatten[pts1 /. n -> θ, 1]]]}, {FaceForm[Directive[cols[[2]]]], Polygon[Dynamic[Flatten[pts2 /. n -> θ, 1]]]}, {FaceForm[Directive[cols[[3]]]], Polygon[Dynamic[Flatten[pts3 /. n -> θ, 1]]]}}}, PlotRange -> {{-5, 5}, {-5 + 3/8, 5 + 3/8}}, Background -> cols[[5]], ImageSize -> 540], {θ, 0., 2π}]] 
Posted 3 years ago
 Very nicely done! I was so impressed that I felt compelled to simplify the code slightly: Manipulate[Graphics[{EdgeForm[Directive[JoinForm["Round"], cols[[4]], Thickness[.006]]], Flatten[Table[Block[{centerpoint = {3 Sqrt[3]/4 i, 3/2 j + (-1)^i 3/8}, ψ, tr}, ψ = 3 Haversine[Clip[θ - π/(3 Sqrt[7]) EuclideanDistance[centerpoint, {0, 3/8}], {0, π}]]; tr = Composition[TranslationTransform[centerpoint], RotationTransform[2 π t/3], TranslationTransform[ψ {Sqrt[3]/4, -1/4}]]; {FaceForm[cols[[t]]], Polygon[tr[BasicTileCoords]]}], {j, layering}, {i, layering}, {t, 1, 3}], 2]}, Background -> cols[[5]], ImageSize -> 540, PlotRange -> {{-5, 5}, {-5 + 3/8, 5 + 3/8}}], {θ, 0, 2 π}, Initialization :> (BasicTileCoords = N[{{0, -1}, {0, 0}, {Sqrt[3]/2, 1/2}, {Sqrt[3]/2, 0}, {Sqrt[3]/4, -1/4}, {Sqrt[3]/4, -3/4}}, 20]; cols = ColorData[{"BlueGreenYellow", "Reverse"}] /@ Subdivide[4]; layering = Flatten[Append[Outer[Times, Range[5, 1, -1], {1, -1}], 0]];)] tho unfortunately it is only slightly faster than the original.
Posted 3 years ago
 Very beautiful! The simplicity of underlying translation contrasts so much the visual complexity, contrasts are dramatic elements in art!
Posted 3 years ago
 - another post of yours has been selected for the Staff Picks group, congratulations !We are happy to see you at the tops of the "Featured Contributor" board. Thank you for your wonderful contributions, and please keep them coming!
Posted 3 years ago
 @Marina Shchitova Thanks. It took me forever to come up with the idea for this, so I'm glad you think it works.
Posted 3 years ago
 @John Fultz Ah, smart! That's way faster. Thanks!
Posted 3 years ago
 @J. M. Oh, right, Haversine[Clip[#,{0,π}]]& is definitely much nicer than my f. Thanks!