Skip to main content

Demonstrate aliasing effect in sound


I'm trying to demonstrate the aliasing effect using sound, that is, when the sample rate is fixed and the sound frequency is increased, we would hear the sound pitch go down when we pass the Nyquist frequency.


Here is what I tried so far:


Manipulate[
EmitSound[
Play[Sin[ω* t], {t, 0, 0.2}, SampleRate -> 900]], {ω, 200, 6000, 10}]


Manipulate[
EmitSound[
Play[Sin[ω* t], {t, 0, 0.2}, SampleRate -> 8000]], {ω,200, 6000, 10}]

Question: The sound is a little bit lag to the slider. Is it possible to create a more responsive one like this


Manipulate[EmitSound[Sound[SoundNote[n, 3]]], {n, 1, 10, 1}]

Answer



Here's one way to explore aliasing in audio using a "chirp" signal (thus avoiding the problems of real-time sound generation). A chirp is a sinusoid-like signal with frequency that constantly increases. Using the formula from the Wikipedia page, the chirp can be generated using


chirp[t_] := Sin[2 Pi (f0 t + (k/2) t^2)];


which is a sinusoid-like signal with instantaneous frequency f0 + kt. Hence the frequency increases as time progresses. If the sampling was done very quickly, then this is what we would hear. However, if the sampling frequency is low (such as 1000 Hz), the frequency will increase only up to the Nyquist frequency (in this case 1000/2 = 500 Hz.).


Select some nominal values and create a sampled version of the signal (using Table).


f0 = 200; k = 100; 
Sound[SampledSoundList[Table[chirp[t], {t, 0, 10, 0.001}], 1000]]

chirp


With these values, the "instantaneous frequency" is 200+100*t Hz. If you press the play button, you can hear the sound starting at 200 Hz and increasing. When it gets to the Nyquist frequency 500 (at about 3 seconds in), it starts to descend. The small upper figure shows (a rough version of) the spectrogram (a plot with time on the horizontal axis and frequency on the vertical axis). This agrees quite nicely with what you hear -- the sine wave sweeping up, then down, then up again over the course of 10 seconds.


Comments

Popular posts from this blog

plotting - Filling between two spheres in SphericalPlot3D

Manipulate[ SphericalPlot3D[{1, 2 - n}, {θ, 0, Pi}, {ϕ, 0, 1.5 Pi}, Mesh -> None, PlotPoints -> 15, PlotRange -> {-2.2, 2.2}], {n, 0, 1}] I cant' seem to be able to make a filling between two spheres. I've already tried the obvious Filling -> {1 -> {2}} but Mathematica doesn't seem to like that option. Is there any easy way around this or ... Answer There is no built-in filling in SphericalPlot3D . One option is to use ParametricPlot3D to draw the surfaces between the two shells: Manipulate[ Show[SphericalPlot3D[{1, 2 - n}, {θ, 0, Pi}, {ϕ, 0, 1.5 Pi}, PlotPoints -> 15, PlotRange -> {-2.2, 2.2}], ParametricPlot3D[{ r {Sin[t] Cos[1.5 Pi], Sin[t] Sin[1.5 Pi], Cos[t]}, r {Sin[t] Cos[0 Pi], Sin[t] Sin[0 Pi], Cos[t]}}, {r, 1, 2 - n}, {t, 0, Pi}, PlotStyle -> Yellow, Mesh -> {2, 15}]], {n, 0, 1}]

plotting - Plot 4D data with color as 4th dimension

I have a list of 4D data (x position, y position, amplitude, wavelength). I want to plot x, y, and amplitude on a 3D plot and have the color of the points correspond to the wavelength. I have seen many examples using functions to define color but my wavelength cannot be expressed by an analytic function. Is there a simple way to do this? Answer Here a another possible way to visualize 4D data: data = Flatten[Table[{x, y, x^2 + y^2, Sin[x - y]}, {x, -Pi, Pi,Pi/10}, {y,-Pi,Pi, Pi/10}], 1]; You can use the function Point along with VertexColors . Now the points are places using the first three elements and the color is determined by the fourth. In this case I used Hue, but you can use whatever you prefer. Graphics3D[ Point[data[[All, 1 ;; 3]], VertexColors -> Hue /@ data[[All, 4]]], Axes -> True, BoxRatios -> {1, 1, 1/GoldenRatio}]

plotting - Adding a thick curve to a regionplot

Suppose we have the following simple RegionPlot: f[x_] := 1 - x^2 g[x_] := 1 - 0.5 x^2 RegionPlot[{y < f[x], f[x] < y < g[x], y > g[x]}, {x, 0, 2}, {y, 0, 2}] Now I'm trying to change the curve defined by $y=g[x]$ into a thick black curve, while leaving all other boundaries in the plot unchanged. I've tried adding the region $y=g[x]$ and playing with the plotstyle, which didn't work, and I've tried BoundaryStyle, which changed all the boundaries in the plot. Now I'm kinda out of ideas... Any help would be appreciated! Answer With f[x_] := 1 - x^2 g[x_] := 1 - 0.5 x^2 You can use Epilog to add the thick line: RegionPlot[{y < f[x], f[x] < y < g[x], y > g[x]}, {x, 0, 2}, {y, 0, 2}, PlotPoints -> 50, Epilog -> (Plot[g[x], {x, 0, 2}, PlotStyle -> {Black, Thick}][[1]]), PlotStyle -> {Directive[Yellow, Opacity[0.4]], Directive[Pink, Opacity[0.4]],