Message Boards Message Boards

[GIF] Magic Carpet (Plane waves)

Plane waves

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 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}]

enter image description here - 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 BY: Moderation Team
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract