Message Boards

WOLFRAM COMMUNITY

11128 Views

5 Replies

6 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Staff Picks Mathematics Visual Arts Dynamic Interactivity Geometry Graphics and Visualization Wolfram Language

[GIF] Release (Flapping triangular grid)

Clayton Shonkwiler

Clayton Shonkwiler, Colorado State University

Posted 9 years ago

Release I liked how Inertia turned out, so I decided to make a triangular grid and see about deforming it in some interesting way. I didn't want to do twisting again, but after an hour or so I realized I was essentially re-creating Dave Whyte's dot line wave, so I decided to go in a different direction. Sorry that the definition of `dots` is so gross... DynamicModule[{cols, dots, xmax = 13, ymax = 13}, cols = GrayLevel /@ {.95, .2}; Manipulate[ dots = Table[(1 - 1/2 Total[ Flatten[Table[(-1)^((i + j + 8)/8) Haversine[ t - Pi Norm[{x, y} - {i, j}]/15], {i, {-4, 4}}, {j, {-4, 4}}], 1]]) {Sqrt[3] x + (-1)^y Sqrt[3]/4 - Sqrt[3]/4, 3 y/2}, {x, -xmax, xmax}, {y, -ymax, ymax}]; Graphics[{cols[[1]], Thickness[.003], CapForm["Round"], Table[Line[dots[[i]]], {i, 1, Length[dots]}], Table[Line[Transpose[dots][[i]]], {i, 1, Length[Transpose[dots]]}], Table[Line[{dots[[i + 1, j + 1]], dots[[i, j]], dots[[i + 1, j - 1]]}], {i, 1, Length[dots] - 1}, {j, 2, Length[Transpose[dots]], 2}]}, ImageSize -> 540, PlotRange -> 35, Background -> cols[[-1]]], {t, 0., 2 Pi}] ]

Flapping triangular grid

Release

I liked how Inertia turned out, so I decided to make a triangular grid and see about deforming it in some interesting way. I didn't want to do twisting again, but after an hour or so I realized I was essentially re-creating Dave Whyte's dot line wave, so I decided to go in a different direction.

Sorry that the definition of dots is so gross...

DynamicModule[{cols, dots, xmax = 13, ymax = 13},
 cols = GrayLevel /@ {.95, .2};
 Manipulate[
  dots = Table[(1 - 
       1/2 Total[
         Flatten[Table[(-1)^((i + j + 8)/8) Haversine[
             t - Pi Norm[{x, y} - {i, j}]/15], {i, {-4, 4}}, {j, {-4, 4}}], 1]]) 
       {Sqrt[3] x + (-1)^y Sqrt[3]/4 - Sqrt[3]/4, 3 y/2},
    {x, -xmax, xmax}, {y, -ymax, ymax}];
  Graphics[{cols[[1]], Thickness[.003], CapForm["Round"], 
    Table[Line[dots[[i]]], {i, 1, Length[dots]}], 
    Table[Line[Transpose[dots][[i]]], {i, 1, Length[Transpose[dots]]}], 
    Table[Line[{dots[[i + 1, j + 1]], dots[[i, j]], 
       dots[[i + 1, j - 1]]}], {i, 1, Length[dots] - 1}, {j, 2,  Length[Transpose[dots]], 2}]}, 
     ImageSize -> 540, PlotRange -> 35, Background -> cols[[-1]]],
  {t, 0., 2 Pi}]
 ]

POSTED BY: Clayton Shonkwiler

5 Replies

Sort By:

J. M.

Posted 9 years ago

Your beautiful animations have once more forced me to delurk. :) Here's my modest improvement: DynamicModule[{xmax = 13, ymax = 13, cols = GrayLevel /@ {.95, .2}}, Manipulate[Graphics[GraphicsComplex[ Flatten[N[Table[(1 - Sum[(-1)^((i + j + 8)/8) Haversine[t - Pi Norm[{x, y} - {i, j}]/15], {i, {-4, 4}}, {j, {-4, 4}}]/2) {Sqrt[3](x + (-1)^y/4 - 1/4), 3 y/2}, {x, -xmax, xmax}, {y, -ymax, ymax}]], 1], {Directive[cols[[1]], AbsoluteThickness[0.1], CapForm["Round"]], {Line[#], Line[Transpose[#]]} &[Partition[Range[(2 xmax + 1) (2 ymax + 1)], 2 ymax + 1]], Line[Flatten[Table[{(2 ymax + 1) i + j + 1, (2 ymax + 1) (i - 1) + j, (2 ymax + 1)i + j - 1}, {i, 2 xmax}, {j, 2, 2 ymax, 2}], 1]]}], ImageSize -> 540, PlotRange -> 35, Background -> cols[[-1]]], {t, 0, 2 Pi}]]

Your beautiful animations have once more forced me to delurk. :)

Here's my modest improvement:

DynamicModule[{xmax = 13, ymax = 13, cols = GrayLevel /@ {.95, .2}},
              Manipulate[Graphics[GraphicsComplex[
              Flatten[N[Table[(1 - Sum[(-1)^((i + j + 8)/8) Haversine[t - Pi Norm[{x, y} - {i, j}]/15],
                                       {i, {-4, 4}}, {j, {-4, 4}}]/2) {Sqrt[3](x + (-1)^y/4 - 1/4), 3 y/2},
                              {x, -xmax, xmax}, {y, -ymax, ymax}]], 1],
              {Directive[cols[[1]], AbsoluteThickness[0.1], CapForm["Round"]],
               {Line[#], Line[Transpose[#]]} &[Partition[Range[(2 xmax + 1) (2 ymax + 1)], 2 ymax + 1]],
               Line[Flatten[Table[{(2 ymax + 1) i + j + 1, (2 ymax + 1) (i - 1) + j, (2 ymax + 1)i + j - 1},
                                  {i, 2 xmax}, {j, 2, 2 ymax, 2}], 1]]}],
               ImageSize -> 540, PlotRange -> 35, Background -> cols[[-1]]], {t, 0, 2 Pi}]]

POSTED BY: J. M.

Clayton Shonkwiler

Clayton Shonkwiler, Colorado State University

Posted 9 years ago

Hey, nice! And thanks for pointing me to the existence of `AbsoluteThickness`, which I wasn't aware of.

POSTED BY: Clayton Shonkwiler

EDITORIAL BOARD

EDITORIAL BOARD, WOLFRAM

Posted 9 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!