# How to plot a hole in a hole in a hole?

There is an image from this book.(page 22)

I want to plot it, but I don't know equation of this surface. Anyone have an idea about it and how to plot it with Mathematica?

## migrated from mathematica.stackexchange.comMar 1 '17 at 17:43

This question came from our site for users of Wolfram Mathematica.

• while interesting, I feel like this is more of a math question on how to parametrize that surface – glS Mar 1 '17 at 14:45
• You might look at the parametric plot of a Klein bottle, it has similar properties (not the same though). See this link. – Phil Neumiller Mar 1 '17 at 15:19
• You could get a shape of the right topology at least by using RegionUnion, RegionDifference etc. on a Sphere, some Cylinder's, and a torus (as an ImplicitRegion perhaps). – Rahul Mar 1 '17 at 15:20
• I could not find anything relevant but may be these links are useful. kleinbottle.com/gallery/Hole-through-a-Hole-in-a-Hole kleinbottle.com/gallery/Spivak_Hole_Pix youtube.com/watch?v=k8Rxep2Mkp8 Especially the video. – Dimitris Mar 1 '17 at 15:54
• I admire everyone's (well, everyone else's) restraint in not mentioning the relevant meme here. – anomaly Oct 31 '17 at 5:26

## 1 Answer

I was planning to answer this on Mathematica.stackexchange but it was migrated before I finished :(

Fortunately it still asks for Mathematica coding tips and additionally my answer contains some formulas so it should be on topic :)

I imagined I will give a neat example of region related features but it is quicker to write parameters manually than to wait for TransformedRegion with Scaling/RotationTransform to return.

torus = ImplicitRegion[(Sqrt[x^2 + y^2] - .7)^2 + z^2 < .2^2, {x, y, z}];

tube = ImplicitRegion[x^2 + y^2 < .1 z^2 + .1, {x, y, z}];

smallTube =  ImplicitRegion[
x^2 + z^2 < .05 (y - 1.2)^2 + .01 && .6 <= y <= 2.5,
{x, y, z}
];

RegionPlot3D[
Fold[
RegionDifference
, Ball[{0, 0, 0}, 2]
, {torus, tube, smallTube
, TransformedRegion[smallTube, ReflectionTransform[{0, 1, 0}]]
}
]
, BaseStyle -> Opacity[.5]
, PlotPoints -> 60
] • Very nice! But I think it deserves also to be in Mathematica.stackexchange:-)! – Dimitris Mar 1 '17 at 20:34
• I cast the final vote on this migration so blame me. Sorry about that. But if it made you get your feet wet over here on Mathematics maybe it's not a bad thing; this community can only be enriched by your presence. – Mr.Wizard Mar 1 '17 at 22:55
• @Mr.Wizard so much sugar :) But thanks, and you are right, it helped me to get wet which was something I was hesitant about :) – Kuba Mar 2 '17 at 8:31