# 3D representation of a Boy surface using a mesh of tubes

“Everything that matters in life flows through tubes.” - Georg Christoph Lichtenberg, The Waste Books

Model of a Boy surface at the Mathematical Research Institute of Oberwolfach, Germany

1. Preceding questions

This is (hopefully) the last of three questions concerning display options of ParametricPlot3D. The first two are

A perforated ding dong surface

and

Jeener's Flower

2. Parametrization

x = 1/2 * ((2 * a^2 - b^2 - c^2) + 2 * b * c * (b^2 - c^2) + c * a * (a^2 - c^2) + a * b * (b^2 - a^2));
y = 7/8 * ((b^2 - c^2) + c * a * (c^2 - a^2) + a * b * (b^2 - a^2));
z = -1/8 * (a + b + c) * ((a + b + c)^3 + 4 * (b - a) * (c - b) * (a - c));

boy = {x, y, z} /. {a :> Sin[u] * Sin[v], b :> Cos[u] * Sin[v], c :> Cos[v]};


3. ParametricPlot3D

The appearance of a Boy surface changes significantly with different viewpoints.

Table[
ParametricPlot3D[boy, {u, 0, Pi}, {v, 0, Pi},
Axes -> False,
Boxed -> False,
Lighting -> "ThreePoint",
PlotPoints -> 40,
ViewPoint -> v],
{v, {Top, Below, {1.3, -2.4, 2}}}] // GraphicsRow


4. Tubification

To look inside and through the surface I tried:

ParametricPlot3D[boy, {u, 0, Pi}, {v, 0, Pi},
Axes -> False,
Mesh -> 12,
PlotPoints -> 80,
PlotStyle -> None,
ViewPoint -> Above] /. Line :> ({Darker @ Red, Tube[#, 0.02]} &)


And to see the first two "generating" curves:

ParametricPlot3D[boy, {u, 0, Pi}, {v, 0, Pi},
Axes -> False,
Mesh -> 1,
PlotPoints -> 40,
PlotStyle -> None,
ViewPoint -> Top] /. Line :> ({Darker @ Red, Tube[#, 0.02]} &)


5. Questions (sorted by relevance)

1. With my very basic appended tubification method I cannot colorize the tubes, nor can I apply a material to them.

2. The first tube plot has a very flat appearance. Maybe an appropriate lighting or another view angle would give a nicer result.

3. I would like to have an option to change the tube profile from round to rectangular.

• ParametricPlot3D[boy, {u, 0, Pi}, {v, 0, Pi}, Axes -> False, PlotPoints -> 100, Mesh -> 1, PlotStyle -> None, ViewPoint -> Above, MeshStyle -> {{MaterialShading[{"Glazed", Red}], Tube[0.07]}}]?
– kglr
Commented Oct 6, 2023 at 11:43
– eldo
Commented Oct 6, 2023 at 11:56
• Hi @eldo, these are great! If you're interested I have a parameterization for Girl's surface that I can share if you want to do that to. Commented Oct 7, 2023 at 15:07

Update: Using one-parameter ParametricPlot3D

{umesh, vmesh} = {Pi/2, Pi/2};

{boy1, boy2} = boy /. {{u -> umesh}, {v -> vmesh, u -> v}};

ParametricPlot3D[{boy1, boy2}, {v, 0, Pi},
PlotStyle ->
{Tube[.1],
PlotPoints -> 50,
PlotRange -> All,
ColorFunction -> Hue,
Lighting -> "ThreePoint",
ViewPoint -> Top,
Axes -> False]


ParametricPlot3D[Evaluate[Table[boy /. u -> i, {i, 0, Pi, Pi/30}]],
{v, 0, Pi},
PlotPoints -> 40, PlotRange -> All,
Lighting -> "ThreePoint", Axes -> False]


ParametricPlot3D[Evaluate[Table[boy /. v -> i, {i, 0, Pi, Pi/30}]],
{u, 0, Pi},
PlotStyle -> Tube[.02],
ColorFunction -> (Hue @ #4 &),
PlotPoints -> 40, PlotRange -> All,
Lighting -> "ThreePoint", Axes -> False]


## 1. Colorize tubes and apply MaterialShading:

### Post-processing

ParametricPlot3D[boy,
{u, 0, Pi}, {v, 0, Pi},
Axes -> False,
Mesh -> 1,
PlotPoints -> 40,
PlotStyle -> None,
ViewPoint -> Top] /.
Line -> ({MaterialShading[{"Glazed", Red}], Tube[#, 0.07]} &)


Replace MaterialShading[{"Glazed", Red}] with MaterialShading["Iron"] to get

Use the rule

Line ->
({Tube[#, 0.07, VertexColors -> (Hue /@ Subdivide[Length@#])]} &)


to get

### MeshStyle with Tube as directive

Alternatively, you can use {directives, Tube[radius]} as a directive in MeshStyle:

ParametricPlot3D[boy,
{u, 0, Pi}, {v, 0, Pi},
Axes -> False,
PlotPoints -> 100,
PlotStyle -> None,
ViewPoint -> Above,
Mesh -> 1,


Use MaterialShading["Iron"] to get

Use options ColorFunction -> Hue and MeshStyle -> {{Tube[0.07]}} to get

• Is it possible to apply a ColorFunction and/or MaterialShading["Iron"]?
– eldo
Commented Oct 6, 2023 at 13:14
• @eldo, added some examples. I don't know how to apply ColorFunction and MaterialShading.
– kglr
Commented Oct 6, 2023 at 13:40
• I didn' want to use them together. The important thing is that I now can combine ColorFunction -> "AlpineColors" with MeshStyle -> Tube[0.02]. When was MeshStyle -> Tube[...] introduced? Couldn't find it in the docs.
– eldo
Commented Oct 6, 2023 at 14:59
• Tube[radius] as directive in PlotStyle or in MeshStyle is undocumented. I think I learned about it from this answer by John Fultz or/and from this answer by Yu-Sung Chang
– kglr
Commented Oct 6, 2023 at 15:13

Here is my code for the Bryant-Kunser parametrization of the Boy surface.

g[w_] := {-3/2 Im[w (1 - w^4)/(w^6 + Sqrt[5] w^3 - 1)],
-3/2 Re[w (1 + w^4)/(w^6 + Sqrt[5] w^3 - 1)],
Im[(1 + w^6)/(w^6 + Sqrt[5] w^3 - 1)] - 1/2};

b[u_, v_] := #/(#.#) &[g[v Exp[I u]]];


Interactive plot of the curves of constant $$v$$, with colored tubes:

Manipulate[ParametricPlot3D[b[u, v], {u, 0, 2 Pi},
PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}, {-2, 1}},
Boxed -> False, SphericalRegion -> True, Axes -> True,
AxesOrigin -> {0, 0, 0},
PlotStyle -> Directive[CapForm[None], JoinForm["Miter"]],
ColorFunction -> "AlpineColors", Method -> {"TubePoints" -> 30}] /.
Line[pts_, rest___] :> Tube[pts, 0.025, rest],
{v, 0, 1}]


Interactive plot of the closed curves along $$u$$ and $$u + \pi$$:

Manipulate[ParametricPlot3D[{b[u, v], b[u + Pi, v]}, {v, 0, 1},
PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}, {-2, 1}},
Boxed -> False, SphericalRegion -> True, Axes -> True,
AxesOrigin -> {0, 0, 0},
PlotStyle -> Directive[CapForm[None], JoinForm["Miter"]],
ColorFunction -> "AlpineColors", Method -> {"TubePoints" -> 30}] /.
Line[pts_, rest___] :> Tube[pts, 0.025, rest],
{u, 0, Pi}]


Combined plots:

ParametricPlot3D[Evaluate[Table[b[u, v], {v, 0, 1, .025}]], {u, 0, 2 Pi},
PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}, {-2, 1}},
Boxed -> False, SphericalRegion -> True, Axes -> True,
AxesOrigin -> {0, 0, 0},
PlotStyle -> Directive[CapForm[None], JoinForm["Miter"]],
ColorFunction -> "AlpineColors", Method -> {"TubePoints" -> 30}] /.
Line[pts_, rest___] :> Tube[pts, 0.025, rest]

ParametricPlot3D[Evaluate[Table[b[u, v], {u, Pi/40, 2 Pi, Pi/40}]], {v, 0, 1},
PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}, {-2, 1}},
Boxed -> False, SphericalRegion -> True, Axes -> True,
AxesOrigin -> {0, 0, 0},
PlotStyle -> Directive[CapForm[None], JoinForm["Miter"]],
ColorFunction -> "SunsetColors", Method -> {"TubePoints" -> 30}] /.
Line[pts_, rest___] :> Tube[pts, 0.025, rest]


The code I've used has been adapted from the documentation of Tube, under Neat Examples; in particular, the options PlotStyle and Method for ParametricPlot3D, and the replacement of Line with Tube.

• Impressive, thank you :)
– eldo
Commented Oct 7, 2023 at 5:26