Message Boards

WOLFRAM COMMUNITY

10339 Views

6 Replies

5 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] Gridded (Associate family of Scherk's surfaces)

Clayton Shonkwiler

Clayton Shonkwiler, Colorado State University

Posted 9 years ago

Gridded The associate family of Scherk's surfaces. The code below implicitly uses the Weierstrass–Enneper parametrization $f(z) = \frac{4}{1-z^2}$, $g(z) = iz$, since $\int_0^\zeta \frac{f(z)(1-g(z)^2)}{2} dz = 2 \operatorname{arctanh} \zeta$, $\int_0^\zeta i \frac{f(z)(1+g(z)^2)}{2} dz = 2 i \arctan \zeta$, and $\int_0^\zeta f(z) g(z) dz = 2 i \operatorname{arctanh}(\zeta^2)$. This is too slow to give a useful `Manipulate`, so I just give the GIF-generating code: scherk2[u_, v_, ?_] := Re[E^(I ?) {ArcTanh[z], I ArcTan[z], I ArcTanh[z^2]} /. z -> u + I v] scherkfamily = Module[{a = .9, cols}, cols = RGBColor /@ {"#07588A", "#E4FCF9"}; ParallelTable[ Show[ ParametricPlot[ Table[scherk2[u, v, ?][[2 ;;]], {v, -a, a, a/7}], {u, -a, a}, PlotRange -> 2, Axes -> None, Background -> Last[cols], ImageSize -> 540, PlotStyle -> cols[[1]]], ParametricPlot[ Table[scherk2[u, v, ?][[2 ;;]], {u, -a, a, a/7}], {v, -a, a}, PlotStyle -> cols[[1]]]], {?, 0., 2 ? - #, #}] &[2 ?/250] ]; Export[NotebookDirectory[] <> "scherkfamily.gif", scherkfamily, "DisplayDurations" -> {1/50}]

Associate family of Scherk's surfaces

Gridded

The associate family of Scherk's surfaces.

The code below implicitly uses the Weierstrass–Enneper parametrization $f(z) = \frac{4}{1-z^2}$, $g(z) = iz$, since

$\int_0^\zeta \frac{f(z)(1-g(z)^2)}{2} dz = 2 \operatorname{arctanh} \zeta$, $\int_0^\zeta i \frac{f(z)(1+g(z)^2)}{2} dz = 2 i \arctan \zeta$, and $\int_0^\zeta f(z) g(z) dz = 2 i \operatorname{arctanh}(\zeta^2)$.

This is too slow to give a useful Manipulate, so I just give the GIF-generating code:

scherk2[u_, v_, ?_] := 
 Re[E^(I ?) {ArcTanh[z], I ArcTan[z], I ArcTanh[z^2]} /. z -> u + I v]

scherkfamily = Module[{a = .9, cols},
   cols = RGBColor /@ {"#07588A", "#E4FCF9"};
   ParallelTable[
      Show[
       ParametricPlot[
        Table[scherk2[u, v, ?][[2 ;;]], {v, -a, a, a/7}], 
          {u, -a, a}, PlotRange -> 2, Axes -> None, 
        Background -> Last[cols], ImageSize -> 540, 
        PlotStyle -> cols[[1]]], 
       ParametricPlot[
        Table[scherk2[u, v, ?][[2 ;;]], {u, -a, a, a/7}], 
          {v, -a, a}, PlotStyle -> cols[[1]]]], {?, 0.,  2 ? - #, #}] &[2 ?/250] 
   ];

Export[NotebookDirectory[] <> "scherkfamily.gif", scherkfamily, 
 "DisplayDurations" -> {1/50}]

POSTED BY: Clayton Shonkwiler

6 Replies

Sort By:

J. M.

Posted 9 years ago

I liked the polar version, too: scherk[r_, ?_, ?_] = FullSimplify[ComplexExpand[With[{z = r E^(I ?)}, Re[E^(I ?) {ArcTanh[z], I ArcTan[z], I ArcTanh[z^2]}]], TargetFunctions -> {Re, Im}]]; With[{a = 0.9, vp = {1.3, -2.4, 2.}, n = 60, ls = Directive[AbsoluteThickness[1.6], Opacity[1, RGBColor["#07588A"]]]}, Animate[ParametricPlot[Most[RotationMatrix[{vp, {0, 0, 1}}].scherk[r, ?, ?]], {r, 0, a}, {?, -?, ?}, Axes -> None, Background -> RGBColor["#E4FCF9"], BoundaryStyle -> ls, Evaluated -> True, Frame -> None, ImageSize -> 540, Mesh -> 13, MeshStyle -> ls, PlotPoints -> {55, 175}, PlotRange -> 2, PlotStyle -> None], {?, 0, 2 ?, 2 ?/(n - 1)}]]

I liked the polar version, too:

scherk[r_, ?_, ?_] = FullSimplify[ComplexExpand[With[{z = r E^(I ?)},
                                  Re[E^(I ?) {ArcTanh[z], I ArcTan[z], I ArcTanh[z^2]}]], TargetFunctions -> {Re, Im}]];

With[{a = 0.9, vp = {1.3, -2.4, 2.}, n = 60, ls = Directive[AbsoluteThickness[1.6], Opacity[1, RGBColor["#07588A"]]]}, 
     Animate[ParametricPlot[Most[RotationMatrix[{vp, {0, 0, 1}}].scherk[r, ?, ?]], {r, 0, a}, {?, -?, ?},
                            Axes -> None, Background -> RGBColor["#E4FCF9"], BoundaryStyle -> ls, Evaluated -> True,
                            Frame -> None, ImageSize -> 540, Mesh -> 13, MeshStyle -> ls, PlotPoints -> {55, 175},
                            PlotRange -> 2, PlotStyle -> None], {?, 0, 2 ?, 2 ?/(n - 1)}]]

woosh

POSTED BY: J. M.

Clayton Shonkwiler

Clayton Shonkwiler, Colorado State University

Posted 9 years ago

Yeah, definitely. Here's the polar one I made before I got rid of the rendered surface altogether (check out the file size to see why I got rid of the rendered surface):

POSTED BY: Clayton Shonkwiler

J. M.

Posted 9 years ago

Hopefully, the following version is a bit more responsive for everybody: With[{a = 0.9, n = 60, ls = Directive[AbsoluteThickness[1.6], Opacity[1, RGBColor["#07588A"]]]}, Animate[ParametricPlot[With[{z = u + I v}, Re[E^(I ?) {I ArcTan[z], I ArcTanh[z^2]}]], {u, -a, a}, {v, -a, a}, Axes -> None, Background -> RGBColor["#E4FCF9"], BoundaryStyle -> ls, Frame -> None, ImageSize -> 540, Mesh -> 13, MeshStyle -> ls, PlotPoints -> 55, PlotRange -> 2, PlotStyle -> None], {?, 0, 2 ?, 2 ?/(n - 1)}]]

Hopefully, the following version is a bit more responsive for everybody:

With[{a = 0.9, n = 60, ls = Directive[AbsoluteThickness[1.6], Opacity[1, RGBColor["#07588A"]]]},
     Animate[ParametricPlot[With[{z = u + I v}, Re[E^(I ?) {I ArcTan[z], I ArcTanh[z^2]}]], {u, -a, a}, {v, -a, a},
                            Axes -> None, Background -> RGBColor["#E4FCF9"], BoundaryStyle -> ls, Frame -> None,
                            ImageSize -> 540, Mesh -> 13, MeshStyle -> ls, PlotPoints -> 55,
                            PlotRange -> 2, PlotStyle -> None], {?, 0, 2 ?, 2 ?/(n - 1)}]]

POSTED BY: J. M.

Clayton Shonkwiler

Clayton Shonkwiler, Colorado State University

Posted 9 years ago

Ah, jeez, that was stupid of me. Of course `ParametricPlot`ing the region will be much faster than plotting dozens of individual curves.

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!