10
$\begingroup$

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.

This page has a nice demonstration at the top with particles instead of pixels.

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[1]; (* 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 *) noise = ImageAdjust@ 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]

peppers with curl noise

Improve this question
$\endgroup$
1
  • $\begingroup$ 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. $\endgroup$ Commented Aug 21, 2021 at 10:28

1 Answer 1

Reset to default
8
$\begingroup$

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`*"] Needs["OpenCLLink`"] SeedRandom[1]; 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]; } } } }"; ImageDisplace = OpenCLFunctionLoad[src, "imageDisplace", { {_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]; OpenCLMemoryUnload[output]; ListAnimate[images]

warping

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[1]; 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]]

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ Why do you use vegetables as initial state? With some laminar flow it could be more obvious that we add turbulence. $\endgroup$ Commented Aug 27, 2021 at 1:02
  • $\begingroup$ @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. $\endgroup$ Commented Aug 27, 2021 at 11:08

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.