Animating Curl noise applied to an image

I'm trying to produce turbulent swirling effects in an image using Curl Noise. The idea is you start off with some random field (usually Perlin noise) and use the curl of this field to displace the pixels of the image. If you iterate this process you should expect to see pixels smeared over lots of small vortices.

For the noise, I've used a random field generator from this answer but with a ParetoDistribution to make more speckled noise than Gaussian.

I want to animate this effect, but unfortunately ListLineIntegralConvolutionPlot is far too slow to produce enough frames in a reasonable amount of time.

Remove["Global*"];
SeedRandom;

(* Taken from GaussianRandomField - but takes a custom distribution *)
RandomField[dist_, size : (_Integer?Positive) : 256,
dim : (_Integer?Positive) : 2, Pk_ : Function[k, k^-3]] :=
Module[{Pkn, fftIndgen, noise, amplitude, s2},
Pkn = Compile[{{vec, _Real, 1}},
With[{nrm = Norm[vec]}, If[nrm == 0, 0, Sqrt[Pk[nrm]]]],
CompilationOptions -> {"InlineExternalDefinitions" -> True}];
s2 = Quotient[size, 2];
fftIndgen = ArrayPad[Range[0, s2], {0, s2 - 1}, "ReflectedNegation"];
noise = Fourier[RandomVariate[dist, ConstantArray[size, dim]]];
amplitude = Outer[Pkn[{##}] &, Sequence @@ ConstantArray[N@fftIndgen, dim]];
InverseFourier[noise*amplitude]]

img = ExampleData[{"TestImage", "Peppers"}];

(* A Pareto distribution gives us more specks than Gaussian *)
Image@Abs@Chop@RandomField[ParetoDistribution[.01, 4.0], 128];
(* Resize and filter it down a bit to smooth out *)
noise = Nest[GaussianFilter[#, 2] &,
ImageResize[noise, ImageDimensions@img], 5]

(* Compute derivatives and curl image *)
{dx, dy} = DerivativeFilter[noise, {{1, 0}, {0, 1}}, 2];
curl = ColorCombine[{dy, ImageMultiply[dx, -1]}];

(* Do the convolution *)
ListLineIntegralConvolutionPlot[{ImageData@curl, img},
RasterSize -> 256] • I'm looking for a result kind of like this touchdesigner tutorial - the problem is Mathematica doesn't have anything like a fast image Displace TOP that touchdesigner has. Aug 21 '21 at 10:28

I've created a very crude OpenCL kernel that can do some warping, however there is a problem. I'm not doing any sampling of the image so some parts appear to get 'stuck' and stop moving, resulting in blocky edges instead of nice vortices. Still, it's progress and is very fast.

Remove["Global*"]
Clear["Global*"]

SeedRandom;
img = ImageResize[ExampleData[{"TestImage", "Peppers"}], 256];
{width, height} = ImageDimensions[img];
noise = RandomImage[1, ImageDimensions@img];
(*Resize and filter it down a bit to smooth out*)
noise = ImageAdjust@Image[Nest[GaussianFilter[#, 3] &, noise, 10]];
(*Compute derivatives and curl image*)
{dx, dy} =
GaussianFilter[#, 2] & /@
DerivativeFilter[noise, {{1, 0}, {0, 1}}, 4];
curlimg = ColorCombine[{dy, -dx}];
{curlx, curly} = ColorSeparate[curlimg];

src = "
__kernel void imageDisplace(
__global mint * input,
__global mint * output,
__global mint * dx,
__global mint * dy,
mint width,
mint height,
mint channels) {
int xi = get_global_id(0);
int yi = get_global_id(1);
int index = xi + yi*width;
if (xi < width && yi < height) {
int newx = xi - dx[index];
int newy = yi - dy[index];
int newindex = newx + newy*width;
if(newx >= 0 && newy >= 0 && newx < width && newy < height) {
for (int c = 0; c < channels; c++) {
output[index*channels + c] = input[newindex*channels + c]; }
}
}
}";

{_Integer, _, "Input"},
{_Integer, _, "Output"},
{_Integer, _, "Input"},
{_Integer, _, "Input"},
_Integer, _Integer, _Integer}, {16, 16},
"ShellOutputFunction" -> Print];

channels = ImageChannels[img];
output = OpenCLMemoryAllocate[Integer, {width, height, channels}];
iterate[input_] := (
ImageDisplace[input, output, curlx, curly, width, height,
channels, {width, height}];
Return[Image[OpenCLMemoryGet[output], "Byte"]])

images = NestList[iterate, img, 30];

ListAnimate[images] Another method using ImageForwardTransformation is too slow, but produces a better result - although some hard edges are still a problem. We produce an interpolation of the curlx and curly images, and then use as our transformation: $$(x_{n+1},y_{n+1}) \leftarrow (x_n,y_n) + d(c_x(x_n), c_y(y_n))$$ where $$c$$ is the curl image:

SeedRandom;
img = ImageResize[ExampleData[{"TestImage", "Peppers"}], 256];
{width, height} = ImageDimensions[img];
noise = RandomImage[1, ImageDimensions@img];
(*Resize and filter it down a bit to smooth out*)
noise = ImageAdjust@Image[Nest[GaussianFilter[#, 3] &, noise, 10]];
(*Compute derivatives and curl image*)
{dx, dy} =
GaussianFilter[#, 2] & /@
DerivativeFilter[noise, {{1, 0}, {0, 1}}, 4];
curlimg = ColorCombine[{dy, -dx}];
{curlx, curly} = ColorSeparate[curlimg];
interpolateGrid[grid_] :=
Interpolation[
Flatten[MapIndexed[Append[#2, #1] &, ImageData[grid], {2}], 1]];
{intpCX, intpCY} = interpolateGrid /@ {curlx, curly};
warp[{x_, y_}] := {intpCX[x, y], intpCY[x, y]}
transformImg[img_] :=
ImageForwardTransformation[img, # + 60*warp[#] &,
DataRange -> {{1, 256}, {1, 256}}]
ListAnimate[NestList[transformImg, img, 25]] • Why do you use vegetables as initial state? With some laminar flow it could be more obvious that we add turbulence. Aug 27 '21 at 1:02
• @AlexTrounev This is an image effect, so it could be any image. I'm trying to apply a kind of turbulence to the image that has many vortices, hence why I'm using curl noise. I'm not as interested in particle simulations / fluid dynamics unless that can produce a similar image effect. Aug 27 '21 at 11:08