15
$\begingroup$

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.

enter image description here

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."

enter image description here

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.}]

enter image description here

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

Man Ray's Human Equations,

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

enter image description here

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

enter image description here

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]

enter image description here

didn't produce the expected result.

5. Question

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

$\endgroup$

1 Answer 1

11
$\begingroup$
  • 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]

enter image description here

  • 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]

enter image description here

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]]

enter image description here

  • 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]

enter image description here

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

enter image description here

$\endgroup$
1
  • $\begingroup$ 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 $\endgroup$
    – eldo
    Dec 1, 2023 at 9:08

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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