Skip to main content

Rotating perspective of an image in the z axis


A purely recreational question, but one I hoped the community would find interesting enough to suggest a way to approach it.


Let me preface this question with the admission that I have done nothing to date with Mathematica's image processing or any other program's image processing. I don't even take photos.


I have an photo of a wall mural:


mural


taken at an angle of approximately 40 degrees to its center. The mural no longer exists so I can't rephotograph it. I'd like to process this image so that I would get an image as if I had a perspective perpendicular to the center (or approximate center) of the mural. One could think of it as say anchoring the right edge of the image and then pulling the left edge forward. Or think of it as the plane of the white wall having an x and y axis with the origin at the center of the image, then I want to rotate the image in the z axis.


I've reviewed Mathematica's image processing functions. I hoped I'd find an obvious way to do this, perhaps using the Morphological Analysis capabilities, but everything appears 2D oriented.


I recognize the difficulty of the problem. Rotating the perspective would require everything to the left of the y axis to enlarge relative to its distance from the y axis while simultaneously doing the inverse to the right of the axis.



3D plots do this inherently, which is why I thought one ought to be able to do this.


ImageData[] and RotationTransform[]


seem likely candidates to do this. The documentation show how to create a


TransformationFunction[]:


enter image description here


The ideas to do this exist, but I haven't found an example of this applied to an image in the way I want to do it.


In the end, I only want the colors of the mural on a white background, like a poster image, I don't need the lighting or the floor or gradations of color. Solid colors for each of the elements would work fine. Doing these things seems relatively straightforward and should reduce the size of a raster file or the amount of data one needs to process and move around.


Can anyone direct me towards any examples or even documentation on how to approach this?


P.S., Can everyone see the wolf in the mural?





I wanted to show what I got to with Vitaliy Kaurov's solution:


 t = FindGeometricTransform[{{1924.19`, 880.846`}, {154.761`, 
1200.69`}, {190.872`, 189.582`}, {1893.24`,
297.914`}}, {{1924.19`, 880.846`}, {175.395`,
1283.22`}, {175.395`, 571.325`}, {1893.24`, 297.914`}},
"Transformation" -> "Perspective"];

ImagePerspectiveTransformation[image, t[[2]], 1000, DataRange -> Full,
PlotRange -> All];
ImageTake[%, {100, 480}, {120, 965}];

ImageAdjust[Lighter[Lighter[%]], 0.85]

enter image description here


This gets me closer to what I hoped than I imagined possible. Given that the original artist constructed the mural as a collage from rectangular sheets of paper, most of which have gone trapezoidalish I still need to twist the image to restore some of what original photo and image processing has skewed. If I figure it out in a reasonable time I'll post the final image. Thanks to all.



Answer



EDIT: Interactive -----------------------------


You may also want to read this blog post.


Here is interactive of the method below. Some initial things:


enter image description here


img = ImageResize[img, 300];

id = img // ImageDimensions


{300, 225}



Now put everything together


Manipulate[
Row[{Show[img,
Graphics[{{FaceForm[None],
EdgeForm[Directive[Dashed, Thick, Blue]], Polygon[pt]}, {Red,

PointSize[Large],
Point[{id/4, {id[[1]]/4, 3 id[[2]]/4},
3 id/4, {3 id[[1]]/4, id[[2]]/4}}]}}]],
Image[ImagePerspectiveTransformation[img,
FindGeometricTransform[
pt, {id/4, {id[[1]]/4, 3 id[[2]]/4},
3 id/4, {3 id[[1]]/4, id[[2]]/4}},
"Transformation" -> "Perspective"][[2]], DataRange -> Full,
PlotRange -> All], ImageSize -> 300]
}]

, {{pt, {id/4, {id[[1]]/4, 3 id[[2]]/4},
3 id/4, {3 id[[1]]/4, id[[2]]/4}}}, Locator}]

enter image description here


OLDER: Manual ----------------------------------------------


Here I explain in detail a manual version of app above. CTRL+d will bring the Drawing Tools palette. Then using the tools below you need to specify 2 set of 4 points for transformation. Basically to show where 4 points on original image map on the image you want. Click on the image with that tool green-circled and CTRL-c to copy the pixel coordinate.


enter image description here


t = FindGeometricTransform[
{{1924.19`, 880.846`},{154.761`, 1200.69`},{190.872`,189.582`},{1893.24`, 297.914`}},
{{1924.19`, 880.846`},{175.395`, 1283.22`},{175.395`,571.325`},{1893.24`, 297.914`}},

"Transformation" -> "Perspective"]

enter image description here


The apply


ImagePerspectiveTransformation[img, t[[2]], 500,DataRange ->Full,PlotRange -> All]

enter image description here


And crop the part you need


ImageTake[%, {5, 250}, {30, 490}]


enter image description here


Comments

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...

equation solving - Invert and fit implicitly defined curve

I need to fit an implicitly defined curve. I thought I could get some data out of Solve , and then using FindFit . Therefore, I would like to find the relation the parametric curve defined by $F(x,y)=0$: Solve[-(1/2) + 1/2 (0.41202 BesselK[0, 0.1 Sqrt[x^2 + y^2]] + (0.101483 x BesselK[1, 0.1 Sqrt[x^2 + y^2]])/Sqrt[x^2 + y^2]) == 0, y] But I can't get an output: Solve was unable to solve the system with inexact coefficients or the system obtained by direct rationalization of inexact numbers present in the system. Since many of the methods used by Solve require exact input, providing Solve with an exact version of the system may help. >> Edit: In particular, I would like to fit the data coming from the curve with the expression of another curve, and not with a function $f(x)$. In particular, since this clearly looks like a cardioid , I would like it to fit to something like it. What other strategies could I try?

dynamic - How can I make a clickable ArrayPlot that returns input?

I would like to create a dynamic ArrayPlot so that the rectangles, when clicked, provide the input. Can I use ArrayPlot for this? Or is there something else I should have to use? Answer ArrayPlot is much more than just a simple array like Grid : it represents a ranged 2D dataset, and its visualization can be finetuned by options like DataReversed and DataRange . These features make it quite complicated to reproduce the same layout and order with Grid . Here I offer AnnotatedArrayPlot which comes in handy when your dataset is more than just a flat 2D array. The dynamic interface allows highlighting individual cells and possibly interacting with them. AnnotatedArrayPlot works the same way as ArrayPlot and accepts the same options plus Enabled , HighlightCoordinates , HighlightStyle and HighlightElementFunction . data = {{Missing["HasSomeMoreData"], GrayLevel[ 1], {RGBColor[0, 1, 1], RGBColor[0, 0, 1], GrayLevel[1]}, RGBColor[0, 1, 0]}, {GrayLevel[0], GrayLevel...