Community RSS Feed
https://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Visual Arts sorted by activeFourier Transforms and 'Hybrid Images' in the Wolfram Language
https://community.wolfram.com/groups/-/m/t/1592896
![A mandrill-pepper hybrid][1]
Recently, I was asked to assist somebody with graphing the Fourier transform of an image. The resulting images were neat, and the work reminded me of a really fun application of Fourier transforms: [Hybrid Images][2]
By taking the Fourier transforms of two images, and combining the high-frequency parts of one with the low-frequency parts of the other, you get an image that looks like one thing when your eyes are focused, and another thing when they are unfocused. The classic example is the Einstein – Marilyn Monroe image.
![Einstein - Marilyn Monroe][3]
Of course, the above example is in black and white, so a natural extension would be to include color. Also, I would like to explore how the image changes as I vary how much of each image is included.
Thankfully, both of these things are easy to do in the Wolfram Language.
As a warmup, let’s simply visualize the Fourier transform of an image by itself. I use one of the test images provided in ExampleData[].
`
mandrill=ExampleData[{"TestImage","Mandrill"}]
`
![Mandrill test image][4]
`
mandrill2 = ColorSeparate[mandrill];
`
With the `ColorSeparate` function, I split the image into its RGB channels. I will be taking the Fourier transform of each of these.
`
shift := Table[(-1)^(i + j) #[[i]][[j]], {i, 1, Length[#]}, {j, 1, Length[#[[1]]]}] &
mandrill3 = Fourier[shift@ImageData@#] & /@ mandrill2;
`
Before taking the transform, I apply a function `shift` to the image, so that the low frequencies of the image will appear at the center of the Fourier transformed image, rather than at the edges.
`
ColorCombine[Image /@ Abs[mandrill3]]
`
![Fourier Transform of Mandrill][5]
And there we have the Fourier transform of our mandrill.
To put it all together, we could write this as
`
ColorCombine[
Image /@ Abs /@
Fourier /@ shift /@ ImageData /@ ColorSeparate[mandrill]]
`
Now that we’ve got the warm-up out of the way, we want to take two different images, and mix them together. We’ll need two images that are the same size, so I’ll set it to manually resize the images to 512*512. All the example images are that size already, but you may need to resize if you want to use something else.
`
size = 512;
test1 = ImageResize[ExampleData[{"TestImage", "Mandrill"}], size];
test2 = ImageResize[ExampleData[{"TestImage", "Peppers"}], size];
ft1 = Fourier /@ shift /@ ImageData /@ ColorSeparate[test1];
ft2 = Fourier /@ shift /@ ImageData /@ ColorSeparate[test2];
`
Now we can make a temporary variable based on one image, and replace a square of size `2x` in the center of the Fourier-transformed image with the corresponding elements of the other image.
`
Manipulate[
Module[{temp = ft1},
temp[[1;;3,size/2-x;;size/2+x,size/2-x;;size/2+x]]=ft2[[1;;3,size/2-x;;size/2+x,size/2-x;;size/2+x]];
ColorCombine[Image/@Abs/@InverseFourier/@temp]],
{x,1,size/2-1,1}]
`
This generates a manipulate box where you can control how much of each image is included. For this example I find that `x=45` or so is the sweet spot for making the Mandrill 'hidden' when seen from afar, as included at the top of the post. We can also swap the two images, and have some hidden peppers in a picture of a Mandrill.
![A pepper-mandrill hybrid][6]
Hopefully, some of you find this as fun as I do. I attach the notebook I used to generate these hybrid images.
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Mathematica_8EZiogEXIi.png&userId=1541430
[2]: https://en.wikipedia.org/wiki/Hybrid_image
[3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Hybrid_image_decomposition.jpg&userId=1541430
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Mandrill.png&userId=1541430
[5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=FTMandrill.png&userId=1541430
[6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Mathematica_4m1iGQm2JR.png&userId=1541430Duncan Pettengill2019-01-16T18:22:25ZMusic Visualization in Mathematica
https://community.wolfram.com/groups/-/m/t/1582655
*Click image to zoom in. Use browser back button to read further.*
----------
[![enter image description here][2]][2]
Over the Christmas holidays, I finally found some time to test out something I had in mind for a while: Creating an abstract visualization of music. These things are well known and are built into many music-players, but I never tried it myself. If you want to know the whole story behind it you can read my [blog-post about home-recording](http://halirutan.de/music/programming/Music-Visualization/).
What I did is importing an MP3 into Mathematica and using `AudioLocalMeasurements` to extract frequencies and loudness of the song.
audio = Import[file];
meas = AudioLocalMeasurements[audio, {"MFCC", "Loudness"},
Association, PartitionGranularity -> Quantity[1./30., "Seconds"]];
This gives two `TimeSeries` and lets you extract values for every time point of the song. The MFCC is a list of numbers that represent (afaik) the strengths of certain frequencies. The loudness is a single number and gives an estimated loudness measure of the portion.
To visualize it, I used a single `ParametricPlot` that uses the frequency-strengths as factors of a simple trigonometric sum which is plotted in a circular fashion. The size of the circular structure is influenced by the loudness and in addition, it rotates slowly over time. To colorize the plot, I used the distance from the origin and employed one of Mathematica’s color schemes. The majority of the function below is setting-up options to create a plot with fixed plot-range, aspect ratio, etc., and turn it into a slightly blurred image of fixed resolution.
(* Change the line below if you want full HD *)
resolution = {1920, 1080}/10;
ratio = Divide @@ resolution;
With[{mfcc = meas["MFCC"], loudness = Rescale[meas["Loudness"]]},
gr[time_?NumericQ] := With[{f = mfcc[time], l = loudness[time]},
Block[{img, t},
With[{s = Sum[4 f[[i]]*Sin[(i + 3)*t], {i, Length[f]}]},
img =
ParametricPlot[(s + 2 l + .1) {Cos[t + .2 time], Sin[t + .2 time]}, {t, 0, 2 Pi},
PlotRange -> {{-2, 2}*ratio, {-2, 2}},
PlotRangeClipping -> True,
PlotRangePadding -> None,
PlotStyle -> Directive[Thickness[0.008]],
Axes -> False,
ColorFunction -> Function[{x, y, u}, ColorData["Rainbow", Norm[{x, y}]]],
ColorFunctionScaling -> False,
Background -> Black,
AspectRatio -> 1/ratio];
GaussianFilter[Rasterize[img, ImageSize -> resolution], First[resolution]/400.]
]]
]
]
gr[250]
This is how a frame at t=250s looks like
![enter image description here][1]
Unspectacular to say the least, but we are not quite done. A simple trick to make it more interesting is to `Fold` frames so that the old frame leaves a trace in each subsequent image. Specifically, I blurred the old frame, enlarged it and cropped it back to the original size. It is then added to the current frame, where I give the old frame a higher weight before using `ImageAdjust` to rescale all pixel values. This makes everything very colorful and foggy, and the enlargement gives the impression as if we would move forward in space.
tstart = 100;
FoldList[
ImageAdjust[
ImageCrop[
ImageResize[5 GaussianFilter[#1, First[resolution]/100.], Scaled[22/20]],
resolution
] + gr[#2]
] &,
gr[tstart], Range[tstart, tstart + 100]
]
[![enter image description here][2]][2]
The above is now used to create a frame each 1/30th second which is then exported as an image. After all frames are created, I merged the music and the single frames into one video using `ffmpeg`, and I have outlined more details on my webpage.
[Here is video of the final result](https://youtu.be/tufrob3Ohlk) and I hope you like it.
[![enter image description here][3]](https://youtu.be/tufrob3Ohlk)
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=frame250.jpg&userId=11733
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=fold.jpg&userId=11733
[3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2019-01-16at11.00.52.png&userId=20103Patrick Scheibe2019-01-04T14:16:37Z