# How can we plot Man Ray's "Shakespearean Equation" w == e^(1/z)?

1. Man Ray

Man Ray (1890 - 1976) was an American artist who spent most of his career in Paris. He was a significant contributor to the Dada and Surrealist movements. Man Ray produced major works in a variety of media, including photography, but considered himself a painter above all.

Man Ray in Hollywood, ca. 1948

2. His photos of mathematical objects

In 1934 Max Ernst suggested that Man Ray photograph the mathematical model collection at the Institut Henri Poincaré. At the institute Man Ray encountered a "dim hall, lined with glass cases containing hundreds of strange objects, covered with dust, objects in wood, plaster, paper-mache, metal, wire string, glass, glue, gelatin, paper."

Man Ray's photography of a Kuen surface, 1935

Many of the models were German in origin, dating back to the late nineteenth and early twentieth centuries. Man Ray ultimately photographed some thirty-four of the approximately three hundred models at the institute. Some of them he used as models for his paintings. More of Man Ray's mathematical works can be seen here (scroll down):

Michael Whittle

3. Reproduction with Mathematica

Most of his object photos can be nicely reproduced with Mathematica, for example:

a = (u^2 * Sin[v]^2 + 1);
x = ((Sin[u] - Cos[u] * u) * Sin[v] * 2) / a;
y = ((Cos[u] + Sin[u] * u) * Sin[v] * 2) / a;
z = Log[Abs[Tan[v/2]]] + Cos[v] * 2 / a;

ParametricPlot3D[{x, y, z}, {u, -4.5, 4.5}, {v, 0.02, 3.12},
Axes -> False,
Background -> GrayLevel[0.2],
Boxed -> False,
Lighting -> "ThreePoint",
Mesh -> 0,
PlotPoints -> 40,
PlotStyle ->
MaterialShading[<|"BaseColor" -> White, "RoughnessCoefficient" -> 0.5 |>],
ViewPoint -> {1.3, 2.4, 1.}]


4. Shakespeares Equation

However, I couldn't replicate his photo of the following surface, which, according to an article in the Notices of the American Mathematical Society

"is based on the essential singularity in the graph of the real part of w == e^(1/z) at z = 0".

It served as template for Man Ray's oil painting shown below:

Man Ray, Shakespearean Equation, Julius Caesar, 1948

My trial with

n = 1;
ComplexPlot3D[Re[E^(1/z)], {z, -n - n I, n + n I},
ColorFunction -> "GrayTones",
PlotPoints -> 60,
Mesh -> 12]


didn't produce the expected result.

5. Question

How can I produce with Mathematica a faithful replica of the "Shakespearean Equation"?

• Need to use Plot3D.
• Need to cut some sigular parts near z==0.
Block[{w = x + I*y},
Plot3D[Re[Exp[1/w]], {y, -.6, .6}, {x, -.2, .8},
ColorFunction -> White,
Mesh -> {{0}, {-5, -4, -3, -2, -1, -.2, -.1, 0, .1, .2, 1, 2, 3, 4,
5, 6, 7, 8}}, MaxRecursion -> 2, PlotPoints -> 100,
PlotRange -> {{-1, 1}, {-1, 1}, {-5, 8}},
MeshFunctions -> {#1 &, #3 &}, Boxed -> False, Axes -> False,
Filling -> Bottom, FillingStyle -> White, BoxRatios -> {1, 1, .5}]]

• To find the proper region,we draw the ContourPlot with some curves which Re[Exp[1/(x + I*y)]]==0.
ContourPlot[Re[Exp[1/(x + I*y)]], {x, -1, 1}, {y, -1, 1},
PlotPoints -> 80, MaxRecursion -> 2,
MeshFunctions -> Function[{x, y, f}, f], Mesh -> {{0}},
MeshStyle -> Cyan, ContourStyle -> None]


• Since Re[Exp[1/(x + I*y)]] // ComplexExpand is E^(x/(x^2 + y^2)) Cos[y/(x^2 + y^2)], we finally find out that we need to remove the region enclose by the curves y/(x^2 + y^2) equal to {2 π + π/2, -(2 π + π/2)}.
ContourPlot[Re[Exp[1/(x + I*y)]], {x, -1, 1}, {y, -1, 1},
PlotPoints -> 80, MaxRecursion -> 2,
MeshFunctions -> Function[{x, y, z}, y/(x^2 + y^2)],
Mesh -> {{2 π + π/2, -(2 π + π/2)}},
MeshStyle -> Cyan, ContourStyle -> None]


Block[{w = x + I*y},
Plot3D[Re[Exp[1/w]], {x, -.2, .8}, {y, -.6, .6},
PlotStyle -> ColorData["GrayTones"],
Mesh -> {{0}, {-5, -4, -3, -2, -1, -.2, -.1, 0, .1, .2, 1, 2, 3, 4,
5, 6, 7, 8}}, MaxRecursion -> 2, PlotPoints -> 100,
PlotRange -> {{-1, 1}, {-1, 1}, {-5, 8}},
MeshFunctions -> {#1 &, #3 &}, Boxed -> False, Axes -> False,
Filling -> Bottom, FillingStyle -> Gray,
RegionFunction ->
Function[{x, y}, -(2 π + π/2) + 1/10 <= y/(x^2 + y^2) <=
2 π + π/2 - 1/10], BoxRatios -> {1, 1, .5},
Lighting -> {{"Point", White, {-1, 1, 20}}},
ViewPoint -> {-2.43, 1.23, 1.99}, ImageSize -> Large]]


• The above plot still missing two cylinder like regions in the center. We try to add them by using Piecewise
f[x_, y_] := Re[Exp[1/(x + I*y)]] // ComplexExpand;
plot = Plot3D[
Piecewise[{{f[x, y], -(2 π + π/2) <= y/(x^2 + y^2) <=
2 π + π/2}, {0,
x <= 0 && ! ( -(2*2 π + π/2) <= y/(x^2 + y^2) <=
2*2 π + π/2)}}, Nothing], {x, -.2, .8}, {y, -.6, .6},
ExclusionsStyle -> None,
Exclusions -> All, PlotStyle -> ColorData["GrayTones"],
Mesh -> {{0}, {-5, -4, -3, -2, -1, -.2, -.1, 0, .1, .2, 1, 2, 3, 4,
5, 6, 7, 8}}, MaxRecursion -> 2, PlotPoints -> 100,
PlotRange -> {{-1, 1}, {-1, 1}, {-5, 8}},
MeshFunctions -> {#1 &, #3 &}, Boxed -> False, Axes -> False,
Filling -> Bottom, FillingStyle -> Gray,
Lighting -> {{"Point", White, {-1, 1, 20}}},
ViewPoint -> {-2.43, 1.23, 1.99}, ImageSize -> Large]


• To print to 3D, rescaling the region maybe useful.
reg = DiscretizeGraphics[plot];
TransformedRegion[reg, ScalingTransform[{1, 1, 1/15}]]


• Wonderful, thank you. I added MeshFunctions -> {Function[{x, y, z}, Abs[z]], Function[{x, y, z}, Arg[z]]}, which is closer to the original mesh, but still not perfect
– eldo
Dec 1, 2023 at 9:08