# How to recreate this image warping effect?

I'm looking to create image warping effect that looks like this animation, which resembles a misshapen magnifying glass being moved over a background:

Not sure where to start, but here are some related posts:

• Maybe also related mathematica.stackexchange.com/a/234660/72682. The hard part is working out what ImageTransformation you need to apply. Nov 15 '20 at 15:44
• Another with distortion: mathematica.stackexchange.com/q/15065/363 Nov 18 '20 at 13:27
• This is solely ImageTransformation. The transformation is a simplified form of blackhole effect with two or three moving blackholes. It is hard to reconstruct the trajectories exact. Nov 20 '20 at 19:20
• Try machine learning. Train a neural net with many such images and then ask your question (easier said than done). Nov 21 '20 at 12:28
• If you have access to the tool that generated this effect, then it may be possible to track randomly coloured pixels via frame-to-frame optical flow. I'd start off with: ImageResize[RandomImage[1, {32, 32}, ColorSpace -> "RGB"], {200, 200}, Resampling -> "Nearest"]. The up-sampling is to mitigate colour shifts when the filter resamples after distortion. It would be very difficult but it's probably the best way to reproduce this exact distortion. Nov 23 '20 at 17:03

We can use cylindrical functions with ImageTransformation[] to show waves on the water, for example

img=


lst = Table[
ImageTransformation[
img, {#[[
1]] (1 +
Sin[Pi x/40] BesselJ[1,
20 Sin[Pi x/
40] Sqrt[(#[[1]] - .5)^2 + (#[[2]] - .5)^2]]), #[[
2]] (1 +
Sin[Pi x/40] BesselJ[1,
15 Sin[Pi x/
40] Sqrt[(#[[1]] - .5)^2 + (#[[2]] - .5)^2]])} &,
Padding -> "Periodic"], {x, 0, 40, 1/2}];


And with some azimuthal waves

lst = Table[
ImageTransformation[
img, {#[[
1]] (1 +
Sin[Pi x/40] Cos[4 Pi ArcTan[#[[1]], 1 - #[[2]]]] BesselJ[1,
20 Sin[
Pi x/40] Sqrt[(#[[1]] - .5)^2 + (1 - #[[2]])^2]]), #[[
2]] (1 +
Sin[Pi x/40] Sin[4 Pi ArcTan[#[[1]], 1 - #[[2]]]] BesselJ[1,
20 Sin[
Pi x/40] Sqrt[(#[[1]] - .5)^2 + (1 - #[[2]])^2]])} (1 +
x/20 Sin[Pi x/40]) &, Padding -> "Periodic"], {x, 0, 40,
1/2}];


Here is the beginning of the transformation in slow motion. We see that the top right and bottom left quadrants are getting heavily distorted in a symetrical way, while the other two quadrants are tilting.

(The gif below was obtained by saving the original gif, then use Import to import the file as a list of 181 images, then Export the first 40 or so of these images as a new gif with the option DiplayDurations->0.6).

Does this help figure out how to do it? It is likely a clue, but I don't know what it means.

The following transformation shows some potential.

list = Table[
ImageTransformation[img, Sin[x Pi #] Sin[ Pi Reverse[#]] &], {x,
0.3, 0.70, 0.01}]


Here is the list as a gif.

Of course there are endless possible variations:

list = Table[
ImageTransformation[img,
0.70 # + 0.1  Sin[x Pi #] Sin[Pi Reverse[#]] + 0.1 &], {x, 0.3,
2.70, 0.01}]