I was on a cruise and the panorama I took was warped due to the ship rocking:
I'm hoping to correct this so that the horizon is level. Here's the full resolution image:
pano = CloudImport @ CloudObject[
"https://www.wolframcloud.com/objects/505ab4f5-2f3b-4284-b159-23b650ec45e6"];
{w, h} = ImageDimensions@pano
Here's what I've tried so far: basically making an Interpolation
function for ImageTransformation
to use:
(* manually chosen points *)
horizon = {{10824.347571942448`, 1828.3412145283764`}, {8600.42723321343`, 1926.247726818544`}, {6562.498576139089`, 2068.3502822741793`}, {4752.2000024980025`, 2189.78709532374`}, {2206.937599920064`, 2306.927070843324`}};
stable = {{16036.104578836932`, 117.17682104316555`}, {16057.281849520385`, 3465.1293964828137`}, {8767.18545163869`, 3474.4392111310954`}, {8663.24290567546`, 173.2403202438045`}, {349.88534172661866`, 160.86133593125487`}, {343.2354741207032`, 3377.453449740208`}};
fixed = Thread @ {horizon[[All, 1]], horizon[[All, 2]] // Mean};
HighlightImage[pano, {Red, Point[horizon], Blue, Point[stable],
Green, Line[Thread[{horizon, fixed}]]}]
t = Thread[{horizon, fixed}]; s = Thread[{stable, stable}];
inter = Interpolation[Join[t, s], InterpolationOrder -> All]
f[{x_: 0, y_: 0}] := With[{v = inter[x, y]}, {Clip[v[[1]], {0, w}], Clip[v[[2]], {0, h}]}]
So it looks like it should be correcting it:
Finally, then this returns an image with a flat horizon, but it looks a bit too pinched:
ImageForwardTransformation[pano, f, DataRange -> Full]
Update:
Reference links and more examples:
ImageForwardTransformation
can be quite slow... $\endgroup$imfunc[{x_, y_}] := {x, y + shifts[[Round[x*2048]]]}
seems faster... $\endgroup$