6
$\begingroup$

I'm trying to visualize Boy's surface using Bryant's parametrization, as per the MathWorld article. However, I'm not sure I understand the parametrization, and I don't know how to implement it when the parameter is complex.

z := u + vI
g1 := -(3/2) Im[(z (1 - z^4))/(z^6 + z^3 √5 - 1)]
g2 := -(3/2) Re[(z (1 + z^4))/(z^6 + z^3 √5 - 1)]
g3 := Im[(1 + z^6)/(z^6 + z^3 √5 - 1)] - 1/2
g = g1^2 + g2^2 + g3^2

ParametricPlot3D[{g1/g, g2/g, g3/g}, {u, 0, 0.5}, {v, 0, 0.5}]

Now, I understand that $z=u+v\mathrm{i}$ is the parameter, and that it must range over the closed unit disc, so $u^2+v^2\leq1$. But I don't know how do do this! (I let $u,v$ range between 0 and 0.5, for good measure, but the graphic appears empty.)

In the end, I want to end up with exactly this image, for which I've been unable to find the original code.

Edit: The 3 solutions provided here worked like a charm (with the caveat that the one using polar coordinates was weirdly sharped, and I couldn't fix that, but I'm a Mathematica newb), and I found another method:

ParametricPlot3D[Boys[u, v], {u, v} ∈ Disk[{0, 0}, 1]]

I don't know why, but using RegionFunction the surface rendered ~30% slower, and, using Piecewise, about %5 slower. The only issue is that the mesh is now weirdly triangulated.

Also, I compiled the actual parametric formula and performance increased threefold:

Boys = Compile[{u, 
v}, {(-(3/2)
    Im[((u + v I) (1 - (u + v I)^4))/((u + 
      v I)^6 + (u + v I)^3 Sqrt[5] - 1.)])/((-(3/2)
     Im[((u + v I) (1 - (u + v I)^4))/((u + 
       v I)^6 + (u + v I)^3 Sqrt[5] - 1.)])^2 + (-(3/2)
     Re[((u + v I) (1 + (u + v I)^4))/((u + 
       v I)^6 + (u + v I)^3 Sqrt[5] - 1.)])^2 + (Im[(
    1 + (u + v I)^6)/((u + v I)^6 + (u + v I)^3 Sqrt[5] - 1.)] - 
   1/2)^2), (-(3/2)
    Re[((u + v I) (1 + (u + v I)^4))/((u + 
      v I)^6 + (u + v I)^3 Sqrt[5] - 1.)])/((-(3/2)
     Im[((u + v I) (1 - (u + v I)^4))/((u + 
       v I)^6 + (u + v I)^3 Sqrt[5] - 1.)])^2 + (-(3/2)
     Re[((u + v I) (1 + (u + v I)^4))/((u + 
       v I)^6 + (u + v I)^3 Sqrt[5] - 1.)])^2 + (Im[(
    1 + (u + v I)^6)/((u + v I)^6 + (u + v I)^3 Sqrt[5] - 1.)] - 
   1/2)^2), (Im[(
   1 + (u + v I)^6)/((u + v I)^6 + (u + v I)^3 Sqrt[5] - 1.)] - 1/
  2)/((-(3/2)
     Im[((u + v I) (1 - (u + v I)^4))/((u + 
       v I)^6 + (u + v I)^3 Sqrt[5] - 1.)])^2 + (-(3/2)
     Re[((u + v I) (1 + (u + v I)^4))/((u + 
       v I)^6 + (u + v I)^3 Sqrt[5] - 1.)])^2 + (Im[(
    1 + (u + v I)^6)/((u + v I)^6 + (u + v I)^3 Sqrt[5] - 1.)] - 
   1/2)^2)}, Parallelization -> True];

I also tried compiling each of $g1,g2,g3,g$ separately, but performance was a bit worse.

$\endgroup$
  • 1
    $\begingroup$ Hello! It's g = g1^2+g2^2+g3^2, right? $\endgroup$ – Ivan May 1 '15 at 20:25
  • $\begingroup$ Yes! Will correct! $\endgroup$ – étale-cohomology May 1 '15 at 20:27
  • 1
    $\begingroup$ Your first problem is that vI is a different variable name; you need v I with a space in between. $\endgroup$ – Rahul May 1 '15 at 20:41
  • 1
    $\begingroup$ "that it must range over the closed unit disc" - that should have tipped you off to use polar coordinates. As I don't have Mathematica on hand, try this: ParametricPlot3D[With[{z = r Exp[I θ]}, (#/(#.#)) &[Re[{I z (1 - z^4), z (z^4 + 1), -(2 I/3) (z^6 + 1)}/(z^6 + Sqrt[5] z^3 - 1) + {0, 0, 1/2}]]], {r, 0, 9/10}, {θ, -π, π}, PlotPoints -> {20, 30}] $\endgroup$ – J. M. will be back soon May 2 '15 at 1:22
  • $\begingroup$ Yes, I totally missed that!! Thanks! $\endgroup$ – étale-cohomology May 2 '15 at 17:21
5
$\begingroup$
z := u + v I
g1 := -(3/2) Im[(z (1 - z^4))/(z^6 + z^3 Sqrt[5] - 1)]
g2 := -(3/2) Re[(z (1 + z^4))/(z^6 + z^3 Sqrt[5] - 1)]
g3 := Im[(1 + z^6)/(z^6 + z^3 Sqrt[5] - 1)] - 1/2
g = g1^2 + g2^2 + g3^2;

You could use Piecewise here.

When Abs[z] > 1, the function is undefined and plots nothing.

ParametricPlot3D[Piecewise[{{{g1/g, g2/g, g3/g}, Abs[z] <= 1}}, Undefined],
                 {u, -1, 1}, {v, -1, 1}]

enter image description here

I'm not an expert on Graphics, but I hope that helps.

$\endgroup$
  • $\begingroup$ You could also add the option RegionFunction -> Function[{x, y, z, u, v}, u^2 + v^2 <= 1] instead of changing the function. $\endgroup$ – Rahul May 1 '15 at 20:42
  • $\begingroup$ Ah, yes, both solutions worked!! Thanks so much! On a totally unrelated note, does anyone happen to know of this parametrization has 3-fold symmetry when viewed from the 'top'? $\endgroup$ – étale-cohomology May 1 '15 at 21:06
  • 1
    $\begingroup$ @Diego, yes, my current Gravatar does display that feature you speak of... $\endgroup$ – J. M. will be back soon May 2 '15 at 0:33
4
$\begingroup$

Altho traditionally one should use polar coordinates as I suggested in a comment above, I found it amusing that ParametricPlot3D[] can actually support a region specification for specifying the domain of the parameters. Thus here is a way to plot the Bryant-Kusner parametrization of the Boy surface:

ParametricPlot3D[With[{z = u + I v}, (#/(#.#)) &[Re[{0, 0, 1/2} +
                      {I z (1 - z^4), z (z^4 + 1), -(2 I/3) (z^6 + 1)}/
                      (z^6 + Sqrt[5] z^3 - 1)]]], {u, v} ∈ Disk[],
                 Axes -> None, Boxed -> False, Mesh -> True,
                 PlotPoints -> {20, 30}, PlotStyle -> Opacity[2/3]]

just look at the threefold symmetry!

where I made the surface translucent to display the inner structure. Mathematically, the construction is an inversion of a certain minimal surface that is topologically equivalent to the projective plane, thrice-punctured. See the linked paper for more background.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.