Magic Carpet
Same 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 Line
s 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}]