Audio Synthesis

Carlo Giacometti, Wolfram Research

Join the Conversation #WolframTechConf

Some basic concepts and tools

{a,b,c}={ExampleData[{"Audio","Piano"}],ExampleData[{"Audio","ThaiBells"}],AudioTrim[ExampleData[{"Audio","Drums"}],3]}

AudioPlot[#,ImageSize->Medium]&/@{a,b,c}

Periodogram[#,4000,ImageSize->Medium,PlotRange->{{0,10000},All}]&/@{a,b,c}

Spectrogram[#,2048,2048,ImageSize->Medium,PlotRange->{All,{0,10000}}]&/@{a,b,c}

Creation of an Audio object

There are several options to create an Audio object:

use the an existing file:

Import["ExampleData/rule30.wav"]

Audio["ExampleData/rule30.wav"]

use a Sound object:

Audio[]

use an explicit list of sample values:

Audio[RandomReal[{-1,1},44100]]

use AudioGenerator:

AudioGenerator["Sin"]

Creation of an Audio object

AudioGenerator can be used with a wide variety of different input.

Basic oscillators

Choose among different basic waveforms:

oscillators={"Sin","Triangle","Sawtooth","Square"};
Panel@TableForm[{
AudioGenerator[#,Appearance->"Minimal"],AudioPlot[AudioGenerator[#],PlotRange->.01,PlotTheme->"Minimal"],
Periodogram[AudioGenerator[#],2000,PlotRange->{{0,2000},All},Ticks->{True,False}]
}&/@oscillators,TableHeadings -> {oscillators, {"Audio", "Waveform", "Spectrum"}},TableSpacing -> {2, 2}]

For all oscillators it is easy to control the frequency and phase of the oscillator:

Manipulate[
Labeled[
AudioPlot[AudioGenerator[{"Sin",freq,phase},.01],PlotTheme->"Minimal",Axes->False],
Text["AudioGenerator[{\"Sin\", "<>ToString[freq]<>", "<>ToString[phase]<>"}]",FormatType->InputForm],
Top
],
{{freq,440},-600,600},{{phase,0},-10,10}]

Noise

Random signals with different spectral characteristics are available:

noises={"White","Pink","Brown","Blue"};
Panel@TableForm[{
AudioGenerator[#,Appearance->"Minimal"],AudioPlot[AudioGenerator[#],PlotRange->.1,PlotTheme->"Minimal"],
Periodogram[AudioGenerator[#],10000,PlotRange->{{0,2000},All},Ticks->{True,False}]
}&/@noises,TableHeadings -> {noises, {"Audio", "Waveform", "Spectrum"}},TableSpacing -> {2, 2}]

It’s possible to produce colored noise, where the spectrum follows a (f^(-α)) distribution:

Manipulate[
Labeled[
Periodogram[AudioGenerator[{"Color",α},.1],1000,ScalingFunctions->{"Log10", "dB"},PlotRange->{All,{-40,10}},PlotStyle->Blend[{,,,,},(α+2.)/4]],
Text["AudioGenerator[{\"Color\", "<>ToString[α]<>"}]",FormatType->InputForm],
Top
],
{{α,0},-2,2}]

Processes and TimeSeries

Generate an Audio object by sampling a random process:

AudioGenerator[FractionalGaussianNoiseProcess[.1]]//AudioNormalize

Instead of using the random process as input, it is also possible to generate a TimeSeries containing a realization of the process

ts=RandomFunction[FractionalBrownianMotionProcess[.5],{0,1,1./44100}]

and transform the resulting TimeSeries into an audio object:

AudioGenerator[ts]

This opens up a lot of possibilities for audio creation.
As an example, we can listen to the to the wind data between 2010 and 2014!

windData=TimeSeriesRescale[WindSpeedData["KJFK",{DateObject[{2010,1,1}],DateObject[{2014,1,8}]}],{0,1}];
ts=QuantityMagnitude@TimeSeries[windData,MissingDataMethod->{"Interpolation",InterpolationOrder->0}];
AudioGenerator[Standardize@ts]//AudioNormalize

Functions

If the input of AudioGenerator is a function, the sample values are computed by sampling the function at the corresponding times:

AudioGenerator[RiemannSiegelZ[1000#]&]//AudioNormalize

Manipulate[Labeled[AudioGenerator[Tanh[c Sin[3. 2 Pi#]]&,SampleRate->1000]//AudioPlot,Text["AudioGenerator[Tanh["<>ToString[c]<>"×Sin[3×2×Pi#]]&]",FormatType->InputForm],Top],{c,1.,10}]

Subtractive Synthesis

Now that we know how AudioGenerator works we can try to create signals with less obvious harmonic content. 
One of the strategies dates back to analog electronics, where the creation of simple waveforms like square and sawtooth was the simplest thing to achieve.

The basics building blocks of synthesis in the early days were oscillators and filters, both relatively easy to build.

Since 11, it is just as simple in Mathematica:

LowpassFilter[AudioGenerator[{"Sawtooth",100}],Quantity[1000,"Hz"],31]

By choosing a waveform with a rich spectrum like sawtooth we can then sculpt the sound using different filters. We can use any of the FIR filters like LowpassFilter, HighpassFilter, BandpassFilter, BandstopFilter, but we can also use any discrete IIR filter by leveraging RecurrenceFilter.

Manipulate[
lpFiltered=filter[AudioGenerator["Square",Appearance->"Minimal"],(Quantity[f, "Hz", hertz, "Hertz"]),101,Padding->0.];
TableForm[{{lpFiltered,
AudioPlot[lpFiltered,PlotRange->.01,PlotTheme->"Minimal",ImageSize->Small],
Periodogram[lpFiltered,1000,PlotRange->{{0,5000},All},Ticks->{True,False},ImageSize->Small]}}],
{{f,600, "Cutoff Frequency"},200,4000},{filter,{LowpassFilter,HighpassFilter}},ContinuousAction->False]

We can also use any of the analog filter models present in the WL

discreteFilter=ToDiscreteTimeModel[BiquadraticFilterModel[{Quantity[470,"Hz"],15}],1./44100,z]

RecurrenceFilter[discreteFilter,AudioGenerator[{"Sawtooth",100}]]//AudioNormalize

Periodogram[%,PlotRange->{{0,1000},{-40,30}}]

Additive Synthesis

In contrast to subtractive synthesis where harmonics are attenuated using filters, additive synthesis is based on the addition of harmonics. The effect is obtained with linear combination of sine waves at different frequencies, where the user has control over the coefficients of the linear combination.

freqs=Range[200,2000,200];

amplitudes=RandomReal[1,10];

Mean@MapThread[#1*AudioGenerator[{"Sin",#2}]&,{amplitudes,freqs}]

Periodogram[%,ScalingFunctions->"Absolute",PlotRange->{{0,2000},All}]

Mean@MapThread[#1*AudioGenerator[{"Sin",#2}]&,{amplitudes,RandomReal[{200,2000},10]}]

Periodogram[%,PlotRange->{{0,2000},All}]

Amplitude Modulation

The idea of starting with sinusoids and then adding other spectral components is behind both frequency and amplitude modulation.

In AM, two signals are used, called carrier and modulator. The result is computed using carrier×(1+μ×modulator), where the scaling constant μ is called modulation index.

If the modulator is a sinusoid, for each component of the carrier at a frequency f, a pair of sidebands is created at frequencies f±m, whose amplitude is controlled by the modulation index.

This is now easy to do in the WL, since arithmetic operations work seamlessly on audio objects:

carrier=AudioGenerator[{"Triangle",400},2]

modulator=AudioGenerator[{"Sin",317},2]

modIndex=1;
am=carrier*(1+modIndex*modulator)//AudioNormalize

Periodogram[{carrier,modulator,am},8000,PlotRange->{{0,2000},All},PlotLegends->{"Carrier","Modulator","AM"}]

Frequency Modulation

We still have a carrier and a modulator signal in frequency modulation (FM), but here the modulator signal controls the frequency of the carrier.

To achieve this, the frequency and phase specifications of all the oscillator models accept time varying inputs in the for of Audio objects, TimeSeries of even functions!

AudioGenerator[{"Sin",400+200AudioGenerator[{"Sin",1},4]}]

modulator=AudioGenerator[{"Sin",400}];
fm=AudioGenerator[{"Sin",250+400*modulator}]

The amount of modulation is controlled by the modulation index. As the modulation index increases, sidebands occur above and below the carrier frequency at intervals of the modulating frequency.

Manipulate[With[
{
fm=AudioGenerator[{"Sin",500+mindex mf*AudioGenerator[{"Sin",mf}]}]
},
Labeled[
Row@{
fm,
Spacer[10],
Periodogram[fm,5000,ScalingFunctions->"Absolute",PlotRange->{{0,1100},All},GridLines->Automatic,ImageSize->Medium]
},
Text["AudioGenerator[{\"Sin\", 500 + "<>ToString[mindex]<>" × "<>ToString[mf]<>" × "<>"AudioGenerator[{\"Sin\", "<>ToString[mf]<>"]]",
FormatType->InputForm
],
Top
]
],{{mf,50,"Modulation Frequency"},10,300},{{mindex,0,"Modulation Index"},0.,10.},ContinuousAction->False]

The position of the sidebands is determined by the ratio between the carrier and modulator frequencies. Changing this ratio, it is possible to obtain both harmonic (typical of pitched instruments) and inharmonic (typical of percussive instruments) spectra.

cf=500;
ratios={3/2,5/2,2/3};
fm=Table[mf=cf/r;
AudioGenerator[{"Sin",cf+3.2 mf Sin[2 Pi mf #]&}],{r,ratios}];
periodograms=Table[Periodogram[fm[[i]],20000,ScalingFunctions->"Absolute",ImageSize->Small,PlotRange->{{0,2000},All},GridLines->Automatic],{i,Length@ratios}];
Panel@TableForm[{fm,periodograms},TableHeadings -> { {"Audio", "Spectrum"},"((Subscript[c, f])/(Subscript[m, f])) = "<>ToString[#,FormatType->StandardForm]&/@ratios},TableSpacing -> {2, 2}]

cf=500;
ratios={Pi,Sqrt[2],GoldenRatio};
fm=Table[mf=cf/r;
AudioGenerator[{"Sin",cf+3.2 mf Sin[2 Pi mf #]&}],{r,ratios}];
periodograms=Table[Periodogram[fm[[i]],20000,ScalingFunctions->"Absolute",ImageSize->Small,PlotRange->{{0,2000},All},GridLines->Automatic],{i,Length@ratios}];
Panel@TableForm[{fm,periodograms},TableHeadings -> { {"Audio", "Spectrum"},"((Subscript[c, f])/(Subscript[m, f])) = "<>ToString[#,FormatType->StandardForm]&/@ratios},TableSpacing -> {2, 2}]

fm=AudioGenerator[{"Sin",500+3  (100+400AudioGenerator[{"Sawtooth",.1},5]) AudioGenerator[{"Sin",100+400AudioGenerator[{"Sawtooth",.1},5]}]}]

Spectrogram[fm,4096,4096,HannWindow,PlotRange->{All,{0,3000}}]

Physical models

String

stringSolution=NDSolveValue[
{1/(200 2 10.)^2(∂_(t,t))u[t,x]==(∂_(x,x))u[t,x]-.0000005(∂_t)u[t,x],
u[0,x]==(E^(-(((x-5))^2))),
Derivative[1,0][u][0,x]==0,
DirichletCondition[u[t, x] == 0, True]},u,{t,0,2},{x,0,10},Method->{"PDEDiscretization"->{"MethodOfLines",{"SpatialDiscretization"->"FiniteElement"}}},MaxSteps->10^6]

Manipulate[Plot[stringSolution[t,x],{t,0,2},PlotRange->All],{{x,5},0,10}]

Manipulate[Audio[Table[stringSolution[t,x],{t,0.,2.,1./44100}]],{x,1,9},ContinuousAction->False]

Sonification

midiToFreq[m_]:=2^((m-69)/12)*440.
dur=20;

AudioGenerator[{"Sin",TimeSeries[midiToFreq/@(50+First@RealDigits[π, 24, 200]),{0,dur}]},dur,"SignedInteger16",SampleRate->16000]

AudioGenerator[{"Sin",TimeSeries[midiToFreq/@(50+First@RealDigits[7/11, 24, 200]),{0,dur}]},dur,"SignedInteger16",SampleRate->16000]

From data

f[t_] := Mod[
t*BitAnd[
BitOr[BitShiftRight[t,12],
BitShiftRight[t,8]],
BitAnd[63,BitShiftRight[t,4]]
],
256,-128
];

a = Audio[Table[f[t],{t,0,100000}],"SignedInteger8",SampleRate->8000]

From text

a=ExampleData[{"Text","AeneidLatin"}];

a//Short

Audio[ToCharacterCode[a]-Round@Mean[ToCharacterCode[a]],"SignedInteger8",SampleRate->8000]

From TimeSeries

finNames = {"MSFT","AAPL","GE","HP"};
financialData = AssociationMap[
TimeSeriesResample[Round[MovingAverage[TimeSeriesRescale[TimeSeries@FinancialData[
#,{"Jan. 1, 2004",DateString[Now]}],{0,dur}],60]],1./8]&,finNames];

Manipulate[
Module[
{a},
Row[{a = Mean[{v1,v2,v3,v4}*audiosFinancial],
ListLinePlot[financialData,PlotRange->All,PlotStyle->(Opacity/@{v1,v2,v3,v4}),ImageSize->Medium]
}]
],
{{v1,.6,finNames[[1]]},0,1},{{v2,0,finNames[[2]]},0,1},{{v3,0,finNames[[3]]},0,1},{{v4,0,finNames[[4]]},0,1},ContinuousAction->False,TrackedSymbols:>{v1,v2,v3,v4},
Initialization:>(audiosFinancial = AudioGenerator[{"Sin",Clip[midiToFreq[50+.5*#],{50,7999}]},dur,"SignedInteger16",SampleRate->16000]&/@(Values@financialData))
]

From Images

{Spectrogram[ExampleData[{"Audio","BlackcapWarbler"}],ImageSize->Medium],ExampleData[{"TestImage","Mandrill"}]}

images=AssociationMap[ExampleData[{"TestImage",#}]&,{"Apples","Elaine","F16","Flower","House2","Mandrill","Tree","Splash"}];

MakeAudioFromImage[img_Image,sr_,dur_] := 
Module[
	{windowSize,offset,length,omega,win,Y,res},
	windowSize = 1024;
	offset = 256;
	length = Round[dur/(offset)*sr];
	omega = 2.*Pi*Range[0, Floor[windowSize/2]]/(windowSize);
	win=Reverse[HannWindow/@(Range[windowSize]/windowSize-.5)];
	Y = Table[E^(I t omega),{t,0.,offset*(length-1)/sr,offset/sr}];
	Y =Y ImageData@ColorConvert[ImageResize[ImageRotate[img,-Pi/2],{Floor[windowSize/2+1],length}],"Grayscale"];
	Y = Join[Y,Take[Conjugate[Reverse[Y,{2}]],All,{2,-2}],2];
	res = ConstantArray[0,offset*Length@Y+windowSize];
	Do[
		res[[1+(i-1)*offset;;(i-1)*offset+windowSize]] += Re[InverseFourier[Y[[i]],FourierParameters->{1,-1}]]*win;
		,
		{i,Length@Y}
	];
	AudioNormalize@Audio[res,SampleRate->sr]
]

res={ImageCrop[ImageResize[Thumbnail[#],300],{270,250}],MakeAudioFromImage[#,8000,20]}&/@Values[images];

Multicolumn[Column/@res,5]

Spectrogram[res[[-3,2]],AspectRatio->1,ColorFunction->GrayLevel]

Karplus-Strong

This is a text cell.

freq=60;
feedback=0.99;
AudioDelay[AudioGenerator["Pink",.01],1/freq,feedback,1,PaddingSize->5,Method->{"LowpassCutoff"->(Quantity[8000, "Hz", hertz, "Hertz"])}]

chord ={130.81,164.81,196,261.62};

Table[AudioDelay[AudioPad[AudioGenerator["Pink",.01],{RandomReal[.2],0}],1/chord[[i]],feedback,1,PaddingSize->5,Method->{"LowpassCutoff"->(Quantity[8000, "Hz", hertz, "Hertz"])}],{i,Length[chord]}]//Mean

Drums

drumSolution = NDSolveValue[
{
.0001(∂_(t,t))u[t,x,y] +.00001(∂_t)u[t,x,y]- Inactive[Laplacian][u[t, x, y], {x, y}] == 0, u[0, x, y] == E^(-5 ((x - .2)^2 + (y - -.127365)^2)), 
Derivative[1,0,0][u][0, x, y] == 0, 
DirichletCondition[u[t, x, y] == 0, True]
}, 
u, 
{t, 0, 2}, 
{x, y} ∈ Disk[],
Method->{"PDEDiscretization"->{"MethodOfLines",{"SpatialDiscretization"->"FiniteElement"}}}
]

Plot[drumSolution[t,0,0],{t,0,2},PlotRange->All]