# Reflection and Anamorphism in a Hanging Conical Mirror

Posted 2 years ago
5892 Views
|
3 Replies
|
19 Total Likes
|
 I took the chrome plated conical mirror used in my previous Wolfram Community contribution, suspended it upside down, and asked myself the (anamorphism) question : what should a (deformed) image look like to be reflected in this mirror as the (undeformed) original? We can use Mathematica to solve this problem!1. Geometry of reflection in a hanging conical mirror An observer looking from a viewpoint at V in the direction of the cone, will see the point S reflected as the point I. Q is the intersection point of the view line VI with the cone. This function computes this intersection: viewlineConeIntersection[{yi_, zi_}, {xv_, zv_}, h0_, h_] := Module[{t1, t2}, t1 = Sqrt[-h^2 xv^2 yi^2 + h0^2 (xv^2 + yi^2) + xv^2 zi^2 + yi^2 zv^2 - 2 h0 (xv^2 zi + yi^2 zv)]; t2 = 1/(h^2 (xv^2 + yi^2) - (zi - zv)^2); {t2 xv ((h0 - zi) (zi - zv) + h (h yi^2 + t1)), t2 yi (h^2 xv^2 + (h0 - zv) (-zi + zv) - h t1), t2 (-h0 (zi - zv)^2 + h^2 (xv^2 zi + yi^2 zv) + h (-zi + zv) t1)}] With the help of viewlineConeIntersection, the following function computes the intersection of the reflection line IQ with the x-y plane. This intersection is the anamorphic map of I. hangingConeAnamorphicMap[{yi_, zi_}, {xv_, zv_}, h0_, h_] := Quiet[Module[{mirror, ptI, ptV, imageTriangle, vwLine, xq, yq, zq, ptQ, xn, yn, zn, ptVr}, mirror = Cone[{{0, 0, h0 + h}, {0, 0, h0}}, 1]; ptI = {0, yi, zi}; ptV = {xv, 0, zv}; imageTriangle = Triangle[{{0, 0, h0}, {0, -1, h + h0 - .001}, {0, 1, h + h0 - .001}}]; If[! RegionMember[imageTriangle, {0, yi, zi}], {yi, zi} = Rest[RegionNearest[imageTriangle, {0, yi, zi}]], {yi, zi}]; vwLine = Line[{ptI, ptV}]; {xq, yq, zq} = viewlineConeIntersection[{yi, zi}, {xv, zv}, h0, h]; ptQ = {xq, yq, zq}; {xn, yn} = Normalize[{xq, yq}]; zn = -Sin[ArcTan[1/h]]; ptVr = ReflectionTransform[{xn, yn, zn}, ptQ][ptV]; Solve[{{x, y, z} \[Element] HalfLine[{ptVr, ptQ}] && z == 0}, {x, y, z}][[1, All, -1]]]] This is the function in action as the pointS follows the anamorphic map of a reflected circle:2. Preparing the imagesIt is clear that the points I all will have to belong to the triangular region Triangle[{{-1,51.98/30},{1,51.98/30},{0,0}}]. The following code computes the function range staring from its triangular domain. Module[{xv = 5., zv = 3., r = 1, h = 51.98/30, h0 = .5, triangle, circlePts, anaCirclePts, trianglePts, anaTrianglePts}, triangle = Triangle[{{-h0 - .02, 0}, {-h0 - h, 1}, {-h0 - h, -1}}]; trianglePts = DeleteDuplicates[ RegionNearest[triangle, CirclePoints[{0, (h0 + h)/2}, 4, 1000]] /. {x_?NumericQ, y_} :> {y, -x}]; anaTrianglePts = DeleteCases[ ParallelMap[Most[hangingConeAnamorphicMap[#1, {xv, zv}, h0, h]] &, trianglePts], {}]; Grid[{Style[#, Bold, 14] & /@ {"Domain", "Range"}, {Rotate[ Graphics[{HatchFilling[], FaceForm[LightGray], EdgeForm[AbsoluteThickness[1.5]], triangle}, PlotRange -> {{-4, 2}, {-2, 2}}, Axes -> True, TicksStyle -> Small, ImageSize -> 400], -Pi/2], Rotate[Graphics[{HatchFilling[], FaceForm[LightGray], EdgeForm[AbsoluteThickness[1.5]], FaceForm[Lighter[Gray, .85]], Polygon[anaTrianglePts]}, PlotRange -> {{-4, 2.5}, {-4.5, 4.5}}, Axes -> True, TicksStyle -> Small, ImageSize -> 300], -Pi/2]}}]] The reflection appearing in the inverted cone will maximum be triangular in shape or at least fit inside a triangle. In our case (we suspend the cone with its tip at .5 above the x-y plane), this is the triangle Triangle[{{-1,51.98/30},{1,51.98/30},{0,0}}]: Graphics[{EdgeForm[Black], HatchFilling[], FaceForm[LightGray], Triangle[{{-1, 51.98/30}, {1, 51.98/30}, {0, 0}}] /. {x_?NumericQ, y_} :> {x, y + 0.5}}, Axes -> True, AxesOrigin -> {0, 0}] In order to fit an image inside this triangle, we need a function that convert the image to a set of colored polygons that fit into the triangle (or other) region. Module[{mandrill, irc}, mandrill = ImageResize[ExampleData[{"TestImage", "Mandrill"}], 100]; irc = imageRegionCrop[mandrill, Region@Triangle[{{-.99, 1}, {.97, 1}, {-.01, -.97}}]]; Graphics[{irc /. {x_?NumericQ, y_} :> {x, y + 1.5}, FaceForm[], EdgeForm[Black], Triangle[{{-.99, 1}, {.97, 1}, {-.01, -.97}}] /. {x_?NumericQ, y_} :> {x, y + 1.5}}, Axes -> True, AxesOrigin -> {0, 0} Axes -> True, AxesOrigin -> {0, 0}]] 3. 3D simulation in Mathematica Now, we convert the triangular set of colored polygons into its anamorphic map with our function hangingConeAnamorphicMap. With Graphics3D, we can see a simulation of how the anamorphic image will look reflected in the hanging cone: Module[{r = 1., h = 51.98/30, h0 = .5, xv = 5, zv = 3.5, mirrorCone, ptV, imageTriangle, img, splitLogo, pixelPolys, anaPolys}, mirrorCone = Cone[{{0, 0, h0 + h}, {0, 0, h0}}, r]; ptV = {xv, 0, zv}; imageTriangle = Triangle[{{0, 0, h0}, {0, -r, h + h0}, {0, r, h + h0}}]; img = ImageResize[ExampleData[{"TestImage", "Mandrill"}], 200]; splitLogo = imageRegionCrop[img, Triangle[{{-1, 51.98/30/2.}, {1, 51.98/30/2.}, {0, -51.98/30/2.}}]]; pixelPolys = splitLogo /. {x_?NumericQ, y_} :> {x, y + 1.5}; anaPolys = DeleteCases[ MapAt[hangingConeAnamorphicMap[#, {5, 1.367}, .5, 51.98/30] &, pixelPolys, {All, -1, All, All}] /. {x_?NumericQ, y_, z_} :> {x, y}, {z == 0}, \[Infinity]]; Graphics3D[{{LightGray, InfinitePlane[{{0, 0, 0}, {1, 0, 0}, {0, 1, 0}}]}, {Opacity[.35], LightGray, Specularity[1, 2], mirrorCone}, {AbsoluteThickness[2], Line[{{0, 0, h + h0 + 2}, {0, 0, h + h0}}], AbsolutePointSize[3], Point[{0, 0, h + h0 + 22}]}, {FaceForm[], EdgeForm[{Blue, AbsoluteThickness[.5]}], imageTriangle}, pixelPolys /. {y_, z_} :> {0, y, z}, anaPolys /. {x_?NumericQ, y_} :> {x, y, 0.001}}]] 5. Real world testingTo test this in a real world setting, we need a printout of the anamorphic image... Graphics[{{Thin, Circle[]}, anaPolys}] ...locate the printout under our hanging conical mirror.......and see the result reflected as the original and undeformed image!
3 Replies
Sort By:
Posted 2 years ago
 Fantastic! thanks for sharing!
Posted 2 years ago
 -- you have earned Featured Contributor Badge Your exceptional post has been selected for our editorial column Staff Picks http://wolfr.am/StaffPicks and Your Profile is now distinguished by a Featured Contributor Badge and is displayed on the Featured Contributor Board. Thank you!
Posted 2 years ago
 Cool~!