Import and process the sound
Import and process the sound
Import Auld Lang Syne as a MIDI file.
In[]:=
auldlangsyne=Import["http://www.evatoller.se/zipped/women/womenschoir_midi_etc_A-D.zip","womenschoir_midi_etc_A-D/midi/auldlangsyne_piano.mid"]
Out[]=
Extract the notes:
In[]:=
notes=Select[Import["http://www.evatoller.se/zipped/women/womenschoir_midi_etc_A-D.zip",{"womenschoir_midi_etc_A-D/midi/auldlangsyne_piano.mid",{"SoundNotes"}}],Length[#]>0&];
In[]:=
Length/@notes
Out[]=
{87,73,82,86}
The beginnings of the four voices:
In[]:=
Sound/@AssociationThread[{"Soprano","Alto","Tenor","Bass"}->Take[notes[[All,1;;10]]]]
Out[]=
Soprano
,Alto
,Tenor
,Bass
In[]:=
tmax=Max[notes[[All,-1,2]]]
Out[]=
49.4958
Convert notes to frequencies:
In[]:=
frequency=<|"C4"->Quantity[261.626`,"Hertz"],"F4"->Quantity[349.228`,"Hertz"],"D4"->Quantity[293.665`,"Hertz"],"A#3"->Quantity[233.082`,"Hertz"],"A3"->Quantity[220,"Hertz"],"A4"->Quantity[440,"Hertz"],"F3"->Quantity[174.614`,"Hertz"],"G4"->Quantity[391.995`,"Hertz"],"E4"->Quantity[329.628`,"Hertz"],"G3"->Quantity[195.998`,"Hertz"],"C5"->Quantity[523.25`,"Hertz"],"D#4"->Quantity[311.127`,"Hertz"],"D5"->Quantity[587.33`,"Hertz"],"A#4"->Quantity[466.164`,"Hertz"],"E3"->Quantity[164.814`,"Hertz"],"B3"->Quantity[246.942`,"Hertz"],"F5"->Quantity[698.46`,"Hertz"],"C#4"->Quantity[277.183`,"Hertz"]|>;
In[]:=
=QuantityMagnitude[frequency];{minf,maxf}=MinMax[]+{-20,20};
Interpolate the frequencies smoothly for each voice
interpolate[{SoundNote[n1_,{t11_,t12_},___],SoundNote[n2_,{t21_,t22_},___]},t_,M_]:=With[{Δt1=t12-t11,Δt2=t22-t21,δ=(t21-t12)+(t12-t11)/M+(t22-t21)/M},Piecewise[{{[n1],t11+1/MΔt1<t<t12-1/MΔt1},{Cos[(t-(t12-1/MΔt1))/δPi/2]^2[n1]+Sin[(t-(t12-1/MΔt1))/δPi/2]^2[n2],t12-1/MΔt1<=t<=t21+1/MΔt2}}]]endSegments[{SoundNote[n1_,{t11_,t12_},___],__,SoundNote[n2_,{t21_,t22_},___]},t_,M_]:=With[{Δt1=t12-t11,Δt2=t22-t21},Piecewise[{{[n1],t<=t11+1/MΔt1}}]+Piecewise[{{[n2],t>=t21+1/MΔt2}}]]
Plot the smoothed frequency(time) curves:
In[]:=
height[t_]=With[{M=3},Map[Function[d,endSegments[d,t,M]+Total[interpolate[#,t,M]&/@Partition[d,2,1]]],notes]];pl=Plot[Evaluate[height[t]],{t,0,50},Exclusions->{},AxesLabel->{"time","frequency"}]
Out[]=
Compare with the piecewise constant frequencies from the MIDI file.
In[]:=
Graphics[Transpose[{{RGBColor[0.368417,0.506779,0.709798],RGBColor[0.880722,0.611041,0.142051],RGBColor[0.560181,0.691569,0.194885],RGBColor[0.922526,0.385626,0.209179]},Apply[Function[{n,t,i,v},With[{f=[n]},Line[{#,f}&/@t]]],notes,{2}]}],Axes->True,AspectRatio->1/2,AxesLabel->{"time","frequency"},AxesOrigin->{0,167}]
Out[]=
Make the digits of the year 2017
Make the digits of the year 2017
Make a region named dr with thickened versions of 2, 0, 1, 7 cut out:
In[]:=
(*imageof"2017"*)im=ImagePad[ImageCrop@Image[Rasterize[Style["2017",60,Bold,FontFamily->"Helvetica"],ImageSize->800,ColorSpace->"Grayscale"]],80,White];(*boundarymeshof2017*)reg=ImageMesh[im];(*trianglemeshof2017*)dr=DiscretizeRegion[reg,MaxCellMeasure->60];rectangle=Rectangle[{0,0},{xmax,ymax}=Round[Max/@RegionBounds[dr]]];(*enclosingletterrectangles*){x20,x01,x17}=Round[Mean[{#1[[1,2]],#2[[1,1]]}]]&@@@Partition[RegionBounds/@SortBy[Take[SortBy[ConnectedMeshComponents[RegionBoundary[dr]],ArcLength],{2,-2}],Mean[MeshCoordinates[#]][[1]]&],2,1];twoR=1<x<x20&&1<y<ymax-1;zeroR=x20<x<x01&&1<y<ymax-1;oneR=x01<x<x17&&1<y<ymax-1;sevenR=x17<x<xmax-1&&1<y<ymax-1;dr
Out[]=
The digits 2, 0, 1, 7 that fit into the above holes:
In[]:=
{reg2,reg0,reg1,reg7}=DiscretizeRegion[RegionDifference[Rectangle[{#1,0},{#2,ymax}],dr],MaxCellMeasure->30]&@@@Partition[{0,x20,x01,x17,xmax},2,1];colored2017[{col2_,col0_,col1_,col7_},{h2_,h0_,h1_,h7_}]={EdgeForm[],Function[{r,h,c},{c,GraphicsComplex[Append[#,h]&/@MeshCoordinates[r],MeshCells[r,2]]}]@@@Transpose[{{reg2,reg0,reg1,reg7},{h2,h0,h1,h7},{col2,col0,col1,col7}}]};Graphics3D[colored2017[{XYZColor[0.6043974419855613,0.5481627489703486,0.06070758994993585],XYZColor[0.3180480185280479,0.39882321040206814`,0.053488882016709094`],XYZColor[0.23839222210493904`,0.3403322196839612,0.3831722497463972],XYZColor[0.2524840935517123,0.21748522921280664`,0.7341325788952462]},{400,300,200,100}]]
Out[]=
Make a harmonic function
Make a harmonic function
Hold the digits 2, 0, 1, 7 at a fixed potential and solve the Laplace equation:
Interactive demonstration
Interactive demonstration
Move through the song interactively: