20
$\begingroup$

Eugen Jahnke (1863 - 1921) studied mathematics and physics at the Humboldt University of Berlin. He became a professor at the Berlin Mining Academy in 1905.

Enter image description here

His "Tables of Functions with Formulae and Curves" first appeared in 1909 and was printed into the 1960s (significantly expanded by Fritz Emde after the death of Jahnke). Used copies are still available. The book was a landmark of the visual presentation of mathematical surfaces. It proved popular not only with mathematicians but also with designers and artists.

Enter image description here

Le Corbusier, Phillips Pavillion, Brussels 1958

Le Corbusier had a copy in his library when designing the Phillips Pavillion (a cluster of nine hyperbolic paraboloids for the Expo '58 in Brussels), and Max Ernst produced several collages which integrated the functional drawings into surreal contexts.

Enter image description here

Max Ernst, The Fable of the Mouse of Milo, c.1948

My aim is to reproduce with Mathematica as faithful as possible Jahnke's drawing of this complex arctan surface:

Enter image description here

The following attempt might be a good starting point,

n = 2;
ComplexPlot3D[ArcTan[z], {z, -n - n I, n + n I},
 AxesOrigin -> {0, 0, 0},
 AxesLabel -> {"x", "y", "z"},
 Boxed -> False,
 ColorFunction -> (GrayLevel[1] &),
 Exclusions -> None,
 Filling -> Bottom,
 Mesh -> {Join[{0}, Range[0, 2, 0.1]], Range[-Pi, Pi, 2 Pi/24]},
 PlotPoints -> 50,
 PlotRange -> {All, All, {0, 2.5}},
 PlotStyle -> Opacity[1],
 ViewPoint -> {3., 2.4, 3}]

Enter image description here

but it lacks some important features, above all the cut-outs.

$\endgroup$
2
  • $\begingroup$ , PlotRange -> {{-2, 2}, {-2, 2}, {0, 2.5}} , PlotStyle -> Glow[White] , ImageSize -> 500 , SphericalRegion -> True , RegionFunction -> Function[{z, f}, -\[Pi]/2 <= Arg[z] < \[Pi]] , FillingStyle -> {HatchShading[1/2, Black]} (*,FillingStyle\[Rule]{HalftoneShading[1/2,Gray,"Line"]}*) , Lighting -> "Accent" ] $\endgroup$
    – Syed
    Dec 3, 2023 at 17:31
  • $\begingroup$ Why don't you put this as an answer? Please add ViewPoint -> {-1.3, -2.4, 2} and FillingStyle -> {HalftoneShading[1/4, Gray, "Line"]}. $\endgroup$
    – eldo
    Dec 3, 2023 at 17:47

2 Answers 2

13
$\begingroup$
n = 2;
ComplexPlot3D[ArcTan[z]
 , {z, -n - n I, n + n I}
 , AxesOrigin -> {0, 0, 0}
 , AxesLabel -> {"x", "y", "z"}
 , Boxed -> False
 , ColorFunction -> (GrayLevel[1] &)
 , Exclusions -> None
 , Filling -> Bottom
 , Mesh -> {Join[{0}, Range[0, 2, 0.1]]
   , Range[-Pi, Pi, 2 Pi/24]}
 , PlotPoints -> 50
 , PlotRange -> {{-n, n}, {-n, n}, {0, 1.5 n}}
 , PlotStyle -> Glow[White]
 , ImageSize -> 500
 , SphericalRegion -> True
 , ViewPoint -> {-1.3, -2.4, 2}
 , RegionFunction -> Function[{z}, -π/2 <= Arg[z] < π]
 , FillingStyle -> {HalftoneShading[1/4, Gray, "Line"]}
 , Lighting -> "Accent"
 ]

enter image description here

$\endgroup$
9
$\begingroup$
  • Try to simulate the effects of lighting.
  • The light from lighting = {3, .2, 2}; seems work fine.
Clear["Global`*"];
f[x_, y_] := Abs@ArcTan[x + I*y];
F[{x_, y_}] := {x, y, f[x, y]};
face[pt1_, pt2_][t_, 
  s_] := {1 - s, 
   s} . {PadRight[#, 3] &@Most@F[{1 - t, t} . {pt1, pt2}], 
   F[{1 - t, t} . {pt1, pt2}]}
pts = {{0, 0}, {4, 0}, {4.5, -.5}, {5, -1.5}, {0, -6}, {-6, 0}, {-1.5,
     5}, {-.5, 4.5}, {0, 4}};
L = .2;
lighting = {3, .2, 2};
plot1 = Function[{pt1, pt2}, 
    ParametricPlot3D[
     face[pt1, pt2][t, s] // Evaluate, {t, 0, 1}, {s, 0, 1}, 
     MeshFunctions -> {#4 &}, 
     Mesh -> With[{λ = 
         Abs@Sin@VectorAngle[Cross[pt2 - pt1], 
            Most@lighting]}, {Flatten@
         Table[{k*L - λ*L/2, k*L + λ*L/2}/
           EuclideanDistance[pt1, pt2], {k, 0, 
           1 + Ceiling[(EuclideanDistance[pt1, pt2] - λ*L/2)/
              L]}]}], MeshShading -> {White, Black}, Boxed -> False, 
     Axes -> False]] @@@ Partition[pts, 2, 1, 1];
plot2 = Plot3D[Abs@ArcTan[x + I*y], {x, y} ∈ Polygon[pts], 
   AxesOrigin -> {0, 0, 0}, AxesLabel -> {"x", "y", "z"}, 
   Boxed -> False, Exclusions -> None, PlotPoints -> 50, 
   MeshFunctions -> {#3 &, Function[{x, y}, Arg@ArcTan[x + I*y]]}, 
   Mesh -> 15, PlotPoints -> 50, PlotRange -> {All, All, {0, 2.5}}, 
   Axes -> False, PlotStyle -> Glow@White];

Show[plot2, plot1, Lighting -> {{"Ambient", White}}, 
 ViewPoint -> {8, 8, 8}, ViewProjection -> "Orthographic", 
 ImageSize -> Large]

enter image description here

Original

  • We again using Plot3D to plot Abs@ArcTan[x + I*y] and set the MeshFunction to be {#3 &, Arg[ArcTan[#1 + I*#2]] &} (Or maybe {Abs@ArcTan[#1 + I*#2] &, Im@ArcTan[#1 + I*#2] &})

  • Cut the plot by Polygon[{{0, 0}, {4, 0}, {4, -1}, {3, -2}, {0, -4}, {-4, 0}, {-2, 3}, {-1, 4}, {0, 4}}].

pts = {{0, 0}, {4, 0}, {4, -1}, {3, -2}, {0, -4}, {-4, 0}, {-2, 
    3}, {-1, 4}, {0, 4}};
Plot3D[Abs@ArcTan[x + I*y], {x, y} ∈ Polygon[pts], 
 AxesOrigin -> {0, 0, 0}, AxesLabel -> {"x", "y", "z"}, 
 Boxed -> False, Exclusions -> None, Filling -> Bottom, 
 MeshFunctions -> {#3 &, Arg[ArcTan[#1 + I*#2]] &}, Mesh -> 15, 
 PlotPoints -> 50, PlotRange -> {All, All, {0, 2.5}}, 
 ViewPoint -> {8, 8, 8}, Axes -> False, 
 FillingStyle -> 
  Directive@{Black, Opacity[1], HatchShading[.6, White]}, 
 Lighting -> "Accent", PlotStyle -> Glow[White]]

enter image description here

  • Another trying.
pts = {{0, 0}, {4, 0}, {4.5, -.5}, {5, -1.5}, {0, -6}, {-6, 0}, {-1.5,
     5}, {-.5, 4.5}, {0, 4}};
reg = Plot3D[Abs@ArcTan[x + I*y], {x, y} ∈ Polygon[pts], 
    PlotRange -> {All, All, {0, 5}}, Mesh -> None, PlotPoints -> 80, 
    MaxRecursion -> 4, PlotStyle -> None, Filling -> Bottom, 
    Boxed -> False, Axes -> False] // DiscretizeGraphics;
plot1 = RegionPlot3D[reg, Mesh -> {200, 100}, 
   MeshFunctions -> {#1 &, #2 &}, Lighting -> "Accent", 
   PlotStyle -> White];
plot2 = Plot3D[Abs@ArcTan[x + I*y], {x, y} ∈ Polygon[pts], 
   AxesOrigin -> {0, 0, 0}, AxesLabel -> {"x", "y", "z"}, 
   Boxed -> False, Exclusions -> None, PlotPoints -> 50, 
   MeshFunctions -> {#3 &, Function[{x, y}, Arg@ArcTan[x + I*y]]}, 
   Mesh -> 15, PlotPoints -> 50, PlotRange -> {All, All, {0, 2.5}}, 
   Axes -> False, PlotStyle -> Glow@White];
Graphics3D[{{plot2[[1]], plot1[[1]]}}, Lighting -> "Accent", 
 Boxed -> False, ViewPoint -> {8, 8, 8}]

enter image description here

  • MeshShading.
Clear["Global`*"];
f[x_, y_] := Abs@ArcTan[x + I*y];
F[{x_, y_}] := {x, y, f[x, y]};
face[pt1_, pt2_][t_, 
  s_] := {1 - s, 
   s} . {PadRight[#, 3] &@Most@F[{1 - t, t} . {pt1, pt2}], 
   F[{1 - t, t} . {pt1, pt2}]}
pts = {{0, 0}, {4, 0}, {4.5, -.5}, {5, -1.5}, {0, -6}, {-6, 0}, {-1.5,
     5}, {-.5, 4.5}, {0, 4}};
plot1 = ParametricPlot3D[
   face[#1, #2][t, s] & @@@ Partition[pts, 2, 1, 1] // Evaluate, {t, 
    0, 1}, {s, 0, 1}, MeshFunctions -> {#4 &}, 
   Mesh -> {{# - 1/60, # + 1/60} & /@ Subdivide[0, 1, 20] // Flatten},
    MeshShading -> {Black, White}, BoundaryStyle -> Gray];
plot2 = Plot3D[Abs@ArcTan[x + I*y], {x, y} ∈ Polygon[pts], 
   AxesOrigin -> {0, 0, 0}, AxesLabel -> {"x", "y", "z"}, 
   Boxed -> False, Exclusions -> None, PlotPoints -> 50, 
   MeshFunctions -> {#3 &, Function[{x, y}, Arg@ArcTan[x + I*y]]}, 
   Mesh -> 15, PlotPoints -> 50, PlotRange -> {All, All, {0, 2.5}}, 
   Axes -> False, PlotStyle -> Glow@White];
Show[plot2, plot1, Lighting -> {{"Ambient", White}}, 
 ViewPoint -> {8, 8, 8}]

enter image description here

$\endgroup$
2
  • $\begingroup$ Thank you, cvgmt, for your excellent answer(s). This time I particularly like how you do the cutouts (I've never this polygon-cut before). $\endgroup$
    – eldo
    Dec 5, 2023 at 14:35
  • $\begingroup$ @eldo How to adjust the mesh shading similar with the effect of light seems not so easy. I can not find out a way. $\endgroup$
    – cvgmt
    Dec 5, 2023 at 14:41

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.