Message Boards Message Boards

GROUPS:

Reflection and Anamorphosis in a Spherical Mirror

Posted 1 year ago
3401 Views
|
3 Replies
|
17 Total Likes
|

This contribution is an extension of my recent Wolfram Demonstration "Spherical Mirror Anamorphosis of Regular Polygons".

two teapots

Two questions can be asked when reflecting an object in a spherical (or other) mirror:

  1. Reflection: how does the (deformed) reflection in a mirror of an object outside the mirror look like?
  2. Anamorphism: how should a (deformed) object outside the mirror look like in order to be reflected in the mirror as the real object?

geometry

In the spherical mirror centered at C, V is the observer's eye position, S is a (real) point outside the mirror and I is its perceived reflected point inside the mirror. One of the reflected light rays leaving S will meet the mirror at Q such that its reflection meets the eye at V. But the eye at V will now perceive the point S at I. This mirror setup can be used for the computation of both reflection and anamorphism and the points I and S form an "enantiomorphic" pair.

To write the functions that map real points S into reflected points I and vice-versa, we use the law of reflection (ReflectionTransform and EuclideanDistance)

sphericalAnamorphMap[imagePt : {xi_, yi_, zi_}] := 
 Module[{solQ, pointQ, reflectionPt, solA},
  (*intersection Q of viewline-sphere: Q*)
  solQ =(*find the intersection*)
   NSolve[{x, y, z} \[Element] 
      HalfLine[{imagePt, {1*^6, 0, 0}}] && {x, y, z} \[Element] 
      Sphere[], {x, y, z}];
  pointQ = First[{x, y, z} /. solQ];
  reflectionPt = ReflectionTransform[pointQ][{-1*^6, 0, 0}];
  solA = First@
    NSolve[EuclideanDistance[pointQ, 
       t*(reflectionPt - pointQ) + pointQ ] == 
      EuclideanDistance[imagePt, pointQ], t];
  (-t*(reflectionPt - pointQ) + pointQ) /. solA]
sphericalReflectionMap[reflectedPt : {xs_, ys_, zs_}] := 
 Module[{plane, solQ, pointQ, solI},
  plane = InfinitePlane[{{0, 0, 0}, {1*^6, 0, 0}, reflectedPt}];
  solQ =(*find the intersection*)
   NSolve[{{x, y, z} \[Element] Sphere[], {x, y, z} \[Element] plane, 
     VectorAngle[reflectedPt - {x, y, z}, {x, y, z}] == 
      VectorAngle[{1*^6, 0, 0} - {x, y, z}, {x, y, z}]}, {x, y, z}];
  pointQ = Last[{x, y, z} /. solQ];
  solI = NSolve[{{x, y, z} \[Element] 
      HalfLine[{{1*^6, 0, 0}, pointQ}], 
     EuclideanDistance[{x, y, z}, pointQ] == 
      EuclideanDistance[{xs, ys, zs}, pointQ]}, {x, y, z}]; 
  First[{x, y, z} /. solI]]

This shows the two functions to be the inverse of one another: anamorphism as the inverse of reflection

sphericalReflectionMap[sphericalAnamorphMap[{-0.12, -0.1582, -0.112}]] 

{-0.12, -0.1582, -0.112}

comparison

In the "anamorphism" to the left, we see a deformed, anamorphic curve that , when reflected in the mirror is observed as a perfect square.

In the "reflection" to the right we see a perfect square reflected in a spherical mirror and observed as a deformed curve. The left graphics was created using the function sphericalAnamorphMap, the right one using the function sphericalReflectionMap .

It is the first one that is computationally very interesting. It solves e.g. the question: compute a curve which, when reflected in a spherical mirror, will be perceived as a perfect square.

The function sphericalAnamorphMap computes the anamorphic map of a single point. We can now make anamorphic objects as collections of points such as: polygons, polyhedra, graphics primitives and -complexes, tessellated objects from e.g ExampleData[{"Geometry3D",...] or from 3D scanned objects on the www.

The following is a Manipulate that computes the spherical anamorphic map of some regular polygons and a circle.

polygon[\[Theta]_, \[Theta]0_, r_, 
  n_] :=(*parametric of a regular polygon*)
 r Cos[Pi/n] Sec[(2 ArcTan[Cot[(1/2) n (\[Theta] - \[Theta]0)]])/
    n] {Cos[\[Theta]], Sin[\[Theta]]}
Manipulate[Module[{polyPts, anamorphPts},
  polyPts =
   ParallelMap[RotationMatrix[\[Alpha]100, {1, 0, 0}].# &,
     ParallelMap[RotationMatrix[\[Alpha]010, {0, 1, 0}].# &,
      ParallelMap[RotationMatrix[\[Alpha]001, {0, 0, 1}].# &,
       ParallelTable[
         polygon[t, .001, r, n], {t, 0, 
          2 \[Pi], \[Pi]/24}] /. {x_?NumericQ, y_?NumericQ} -> {0, x, 
          y}]]] /. {x_?NumericQ, y_?NumericQ, z_?NumericQ} -> {x + dx,
       y, z};
  anamorphPts = Map[sphericalAnamorphMap, polyPts];
  Graphics3D[{
    {Gray, Opacity[.35], 
     InfinitePlane[{{0, 0, -2}, {0, 1, -2}, {1, 0, -2}}]},
    {(*full sphere*){Opacity[.1], Lighter[Orange, .75], Sphere[]},
     (*spherical mirror*)
     Style[Sphere[], Specularity[White, 25], Blue, Opacity[.3], 
      ClipPlanes -> InfinitePlane[{{0, 0, 0}, {0, 1, 0}, {0, 0, 1}}]]},
    (*view cone base*){Opacity[.4], EdgeForm@AbsoluteThickness[2], 
     Cylinder[{{0, 0, 0}, {-.01, 0, 0}}, 1]},
    {Red, Tube[polyPts, .025], Tube[anamorphPts, .05]}},
   Boxed -> False, PlotRange -> {{-1.5, 4}, {-2, 2}, {-2, 2}}, 
   ViewPoint -> Dynamic@vwp]],
 "Geometry", {{r, .7, "Circumradius"}, .25, .988, .01, 
  ImageSize -> Small}, {{n, 4}, {3, 4, 5, 6, 51 -> "circle"}, 
  SetterBar, Appearance -> "Horizontal" -> {1, 5}}, Delimiter,
 "Rotate around", {{\[Alpha]001, .01, "z-axis"}, -\[Pi], \[Pi], 
  ImageSize -> Small},
 {{\[Alpha]010, .01, "y-axis"}, -\[Pi], \[Pi], ImageSize -> Small},
 {{\[Alpha]100, .01, "x-axis"}, -\[Pi], \[Pi], 
  ImageSize -> Small}, Delimiter,
 "Move front/back", {{dx, -.4}, -1, 1, .01, 
  ImageSize -> Small}, Delimiter,
 "View direction", {{vwp, {1.3, -2.4, 2}, 
   ""}, {{1, -100, 2} -> "sideways", 
   Right -> "in front", {0, -.05, 100} -> 
    "from top", {1.3, -2.4, 2} -> "default"}, SetterBar, 
  Appearance -> "Horizontal" -> {2, 2}}, TrackedSymbols :> True, 
 SynchronousUpdating -> False]

manipulate polygons

If we rotate the reflection of a circle around the z-axis (right) or the y-axis (left) and track the anamorphic image, we get this GIF:

rotating circle

We can now extend our anamorphic imaging to 3D with polyhedron frames:

Manipulate[
 Module[{vertices, edges, polyPts, rotatedPts, anamorphPts},
  vertices = r*PolyhedronData[pHedron, "Vertices"] // N;
  edges = PolyhedronData[pHedron, "Edges"];
  polyPts = 
   ParallelTable[(1 - t) #[[1]] + t #[[2]], {t, 0, 
       1, .2}] & /@ (Part[vertices, #] & /@ edges);
  rotatedPts =
   ParallelMap[RotationMatrix[\[Alpha]100, {1, 0, 0}].# &,
     ParallelMap[RotationMatrix[\[Alpha]010, {0, 1, 0}].# &,
      ParallelMap[RotationMatrix[\[Alpha]001, {0, 0, 1}].# &,
       r*polyPts, {2}], {2}], {2}] /. {x_?NumericQ, y_?NumericQ, 
      z_?NumericQ} -> {x + dx, y, z};
  (*anamorphic map of rotated points*)
  anamorphPts = Map[sphericalAnamorphMap, rotatedPts, {2}];
  Graphics3D[{{Gray, Opacity[.25], 
     InfinitePlane[{{0, 0, -2}, {0, 1, -2}, {1, 0, -2}}]},
    {(*full sphere*){Opacity[.1], Lighter[Orange, .6], Sphere[]},
     (*spherical mirror*)
     Style[Sphere[], Specularity[White, 25], Gray, Opacity[.4], 
      ClipPlanes -> InfinitePlane[{{0, 0, 0}, {0, 1, 0}, {0, 0, 1}}]]},
    {Red, Tube[#, .02] & /@ rotatedPts, Tube[anamorphPts, .035]}}, 
   Lighting -> {{"Ambient", GrayLevel[0.25]}, {"Directional", White, 
      ImageScaled[{1, 1, 1}]}},
   Axes -> False, Boxed -> False, 
   PlotRange -> {{-1.25, 4}, {-2, 2}, {-2, 2}}]],
 "Polyhedron",
 {{pHedron, "Dodecahedron", ""}, {"Cube", "Dodecahedron", 
   "Icosahedron", "RhombicHexecontahedron"}, SetterBar, 
  Appearance -> "Horizontal" -> {4, 1}},
 {{r, .65, "Circumradius"}, .25, .988, .01, 
  ImageSize -> Small}, Delimiter,
 "Rotate around", {{\[Alpha]001, .1, "z-axis"}, -\[Pi], \[Pi], 
  ImageSize -> Small},
 {{\[Alpha]010, .01, "y-axis"}, -\[Pi], \[Pi], ImageSize -> Small},
 {{\[Alpha]100, .01, "x-axis"}, -\[Pi], \[Pi], 
  ImageSize -> Small}, Delimiter,
 "Move front/back", {{dx, -.40}, -1, 1, .01, 
  ImageSize -> Small}, Delimiter,
 SynchronousUpdating -> False]

manipulate polyhedron

If we rotate the reflection of the cube frame around the z - axis (right) or the y - axis (left) and track the anamorphic image, we get this GIF :

enter image description here

We can also do this for the RhombicHexecontahedron or spikey! (here rotated around the z-axis)

enter image description here

As I did for the cylindrical mirror anamorphosis on my community contribution: Anamorphosis of 3D-Objects & 3D Printing, the mesh of the "Utah Teapot" can also be used after appropriate scaling.

getAndRescale[example_String] := 
 Module[{data, ranges, maxRange, temp1, temp2},
  data = ExampleData[{"Geometry3D", example}, "PolygonObjects"];
  ranges = MinMax@Flatten[data[[All, 1]], 1][[All, #]] & /@ Range[3];
  maxRange = MaximalBy[Most@ranges, Abs[Subtract @@ #] &]; 
  temp1 = MapAt[Rescale[#, First@maxRange, {-1, 1}] &, 
    data, {All, 1, All, 1}];
  MapAt[Rescale[#, 
     Last@ranges, {0, 
      2*Subtract @@ ranges[[3]]/Subtract @@ ranges[[1]]}] &, 
   temp1, {All, 1, All, 3}]]
Module[{\[Phi], pts, pts0, offset, ri, data, anaData},
 offset = 1/5; ri = Sqrt[1 - offset^2]; \[Phi] = ArcTan[5, 2.5];
 (*clippane anchors*)
 pts0 = {{offset, 0, 0}, {offset, ri, 0}, {offset, 0, ri}}; 
 pts = RotationMatrix[-\[Phi], {0, 1, 0}].# & /@ pts0;
 data = getAndRescale[
    "UtahTeapot"] /. {x_?NumericQ, y_?NumericQ, 
     z_?NumericQ} -> .7 {y - .65, x, z - .5};
 anaData = 
  ParallelMap[(*adapted function sphericalAnamorphMap3D in s"pikey \
gor ptnting.nb" attached*) sphericalAnamorphMap3D[#, {5, 2.5}] &, 
   data, {3}];
 Graphics3D[{
   {Gray, Opacity[.25], 
    InfinitePlane[{{0, 0, -1}, {0, 1, -1}, {1, 0, -1}}]},
   {(*spherical mirror*)
    Style[Sphere[], Specularity[White, 25], Gray, Opacity[.24], 
     ClipPlanes -> InfinitePlane[pts]]},
   {FaceForm[Lighter[Orange, .85]], EdgeForm[{Thin, Black}], data, 
    FaceForm[Lighter[Orange, .65]], anaData}, Opacity[.25]}, 
  Boxed -> False]]

These are two perpendicular views of the teapot reflection and its corresponding anamorphic image.

teapot duo

I printed the the right teapot on iMaterialise (STL file "utahTeapot.stl" attached).

teapot = Graphics3D[anaData];
Printout3D[teapot, "utahTeapot.stl", TargetUnits -> "Centimeters", 
  RegionSize -> 7.25];
Printout3D[teapot, "IMaterialise", TargetUnits -> "Centimeters", 
 RegionSize -> 7.25]

teapot printing

This is a photo of the printed anamorphic teapot reflected in a 7cm diameter reflective Christmas ball.

teapot reflection

Enjoy 3D spherical anamorphism printing.

Attachments:
3 Replies

enter image description here - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming, and consider contributing your work to the The Notebook Archive!

Posted 1 year ago

Erik's Anamorphic Reflections Seasons (2D and 3D, cylindrical and sphere) are much more exciting and certainly more productive than "The Game of Thrones".

Something is similar. I printed a 3D spikey model ?top image?a few months before. Later one of my friends took a photo with a crystal ball ?bottom image?. It’s interesting to compare the result of spherical lens and spherical mirror. And notice their difference.

enter image description here enter image description here

It's interesting to modeling a spherical lens with Mathematica. Later it's possible to combine mirrors and lens to build more complex optical system.

Posted 1 year ago

Thanks Frederick for your interest and nice compliment! Here is an article that might interest you (unfortunately in French but with a lot of drawings, code and formulas...) "Images dans un miroir sphérique" by Henri Bouasse

He treats about reflection in a sphere. It is clear from this article that the math and coding of reflection is way more complicated than anamorphism. Something I also realized during my "experiments".

This is one of his examples and he explains the math and geometry of reflection of spheres, cylinders, cubes, etc. in a special mirror.

enter image description here

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract