# [GIF] Magic Carpet (Plane waves)

Posted 2 years ago
3744 Views
|
|
7 Total Likes
|
 Magic CarpetSame basic idea as Square Up, but with no growth/decay, many more fundamental domains, and a much coarser discretization. The biggest challenge was to get the filesize small enough to post on Twitter, Tumblr, etc. As usual, this should really be a Plot3D with PlotStyle->None and an appropriately placed and styled Mesh, but since you can't have a single mesh line change colors, I had to make a bunch of Lines with appropriate VertexColors, which is computationally kind of expensive (more precisely, transforming the graphics from Mathematica's internal representation to a form that can be displayed or exported seems to be expensive). So no Manipulate, but here's the code I used to make the GIF: carpet = Module[ {n = 100, r = 50, cols, dots}, cols = RGBColor /@ {"#9EFFA9", "#36485E", "#333146"}; ParallelTable[ dots = Table[{r π (x - 1)/n, r π (y - 1)/n, Sin[r π (x - 1)/n - t] Sin[r π (y - 1)/n - t]}, {x, 1, n + 1}, {y, 1, n + 1}]; Graphics3D[ {Thickness[.00375], Table[ Line[#[[i]],VertexColors -> (Blend[cols[[;; -2]], (# + 1)/2] & /@ #[[i, ;; , 3]])], {i, Length[#]}] & /@ {dots, Transpose[dots]}}, Boxed -> False, PlotRange -> {{-.5, r π + .5}, {-.5, r π + .5}, {-2.5, 2.5}}, ImageSize -> 540, ViewPoint -> .47 {1, 0, 1}, SphericalRegion -> True, Background -> cols[[-1]]], {t, 0., π - #, #}] &[2 π/50] ]; Export[NotebookDirectory[] <> "carpet.gif", carpet, "DisplayDurations" -> {1/24}]