Waves

Import["/home/kirscher/Documents/vault/Vorlesungen/FIC_102/chapel-and-church-organ-prelude-intro-in-d-major-11871.mp3"]

Import["/home/kirscher/Documents/vault/Vorlesungen/FIC_102/Langenzenn_Orgel.jpg"]
Print["Organ installed in the curch of Langenzenn (Germany) in 1982.\n Background reading:"]
Hyperlink["\"The Physics of Organ Pipes\" (N.H. Fletcher and S. Thwaites, 1983)","https://www.jstor.org/stable/24968811"]

organs unaltered since ≈17th century.
composite of up to (10^4) “pan” pipes. 
working mechanism: 19th  H. von Helmholtz, Lord Rayleigh

longitudinal

T=1;L=7;ϵ=.01;H=.6;
plotstyle={
(* 1: sum *) Directive[Dashing[{}],Thick,Black],
(* 2: right *) Directive[Dashing[{}],Thick,Blue],
(* 3: left *) Directive[Dashing[{}],Thick,Red],
(* envelope, option 8, plotstyle[[4]] *) Directive[Dotted,Gray], 
(* envelope, option 8, plotstyle[[5]] *) Directive[Dotted,Gray], 
(* pipe border, no option, plotstyle[[6]] *) Black,
(* pipe border, no option, plotstyle[[7]] *) Black
};
(* create a bunch of spread out points, deleting near duplicates: *)
pts=Union[Transpose@{RandomReal[{-0.8(2L),L+0.8(2L)},#],RandomReal[{-H,H},#]}&@15000,SameTest->(EuclideanDistance[#1,#2]<.1&)];
(* x-coordinates for a bunch of spaced out vertical lines: *)
lineData=Range[-0.8(2L),L+0.8(2L),.01L];
lop[l_List] := Select[l,0≤#≤L&]
(* function to throw away out of range x-coordinates *)
lopPoints[l_List] := Select[l,0≤#[[1,1]]≤L&] ;(* function to throw away Points with out of range x-coordinates *)
(* functions to graph: waves moving right|left *)
fRight[x_,t_]:=Cos[2π(x/λ-t/T)];
fLeft[x_,t_]:= Cos[2π(x/λ+t/T)];
(* function to draw an arrow unless x-coords are too close, then a point: *)
myArrow[{x1_,x2_},y_]:=
Switch[Norm[x2-x1],
_?(#<.1&),Point[{(x1+x2)/2,y}],
_,Arrow[{{x1,y},{x2,y}},ϵ]];
(* build "longitudinal envelope", a list of arrows (or points) showing relative sizes of displacements: *)
Clear[hArrows];
hArrows[n_,L_,λ_,end_] := hArrows[n,L,λ,end] =If[end=="none",{},{Gray,Arrowheads[{-ϵ,ϵ}],
Outer[myArrow[#2,#1]&,
H Range[-.8,.8,.4] (* y-coordinates *), 
Partition[
(* massaged x-coordinates between which to draw the arrows: *)
Join[#-0.075λ Cos[((4π #)/λ)+(π/2)]&/@Range[0.0,L+ϵ λ,λ/If[end=="closed"&&n==1,26,If[n≤2,14,If[n≤5,10,6]]]],If[end=="closed" (* add one extra end coordinate *),{L},{}]],
2,1],
1]}];
dlabels[n_,L_,λ_,end_] := dlabels[n,L,λ,end]={{Text[Subscript["N","d"],#]& /@ Table[{x,.8},{x,λ/4,L,λ/2}]},
{Text[Subscript["A","d"],#]& /@ Table[{x,.8},{x,0,L,λ/2}]}};
plabels[n_,L_,λ_,end_]:= plabels[n,L,λ,end]={{Text[Subscript["A","p"],#]& /@ Table[{x,-.85},{x,λ/4,L,λ/2}]},
{Text[Subscript["N","p"],#]& /@ Table[{x,-.85},{x,0,L,λ/2}]}};
transverseIcon=Plot[Cos[t],{t,0,3π},PlotRange->All,ImageSize->19,Axes->False];
pipecaps={{},Line[{{L+ϵ,-H-ϵ},{L+ϵ,H+ϵ}}],
Line[Partition[Table[{L+0.04(1-(-1)^i),(-1+(2/12)i)(H+2ϵ)},{i,0,12}],2,1]]};

Manipulate[
Module[{longitudinalShown,densityShown,transverseShown,λ},
(* if option button 4, buttons 1|2|3 mean show both|left|right longitudinal waves (lines): *)
longitudinalShown=options ⋂ If[MemberQ[options,4],If[end≠"none",{1,2,3},{1,2}],{}];
(* if option button 5, buttons 1|2|3 mean show both|left|right longitudinal waves (points): *)
densityShown=options ⋂ If[MemberQ[options,5],If[end≠"none",{1,2,3},{1,2}],{}];
(* if option button 6, buttons 1|2|3 show both|left|right transverse waves, *)
(* option button 8 means transverse envelope, functions 4&5 *)
(* always show pipe border: functions 6&7 *)
transverseShown=Flatten[{
(options ⋂ If[MemberQ[options,6],{1,2,3,8},{8}]⋂ If[end≠"none",{1,2,3,8},{1,2}]) /. 8->{4,5},6,7}];
λ=4L/(2n-Boole[end=="closed"]); (* "closed": 4L/(2n-1), else: 2L/n *)
Pane[
Plot[Evaluate@({
(* 1: sum *) 0.5 H (fRight[x,t]+Boole[end≠"none"] fLeft[x,t]),
(* 2: right *) 0.5 H fRight[x,t]+ϵ,
(* 3: left *) 0.5 H fLeft[x,t] -ϵ,
(* 4,5: envelope, option 8 *) H Cos[2π(x/λ)], - H Cos[2π(x/λ)],
(* 6,7: pipe, no option *) -(H+2ϵ), (H+2ϵ)
}[[transverseShown]]),{x,0,L},ImageSize->{1550,350},
Filling->
If[MemberQ[transverseShown,4 (* envelope = 4&5 *)], #->{#+1}& @ First@First@Position[transverseShown,4],None],
PlotStyle->Evaluate[plotstyle[[transverseShown]]],Axes->None,AspectRatio->Automatic,PlotRange->1,
Epilog->{
(* end: nothing | single line | zigzag *)
pipecaps[[Switch[end,"open" ,1,"closed",2,"none",3]]],
(* longitudinal wave representation, vertical lines: *)
{MapThread[List,{
{Black,Blue,Red}[[longitudinalShown]], 
Map[Line[{{#,-H},{#,H}}]& ,
 lop/@ Transpose[
({#+0.07λ(fRight[#,t]+Boole[end≠"none"] fLeft[#,t]),
#+0.07λ fRight[#,t],
#+0.07λ fLeft[#,t]}[[longitudinalShown]])& /@ lineData],{2}]
}]},
(* longitudinal wave representation, points: *)
{MapThread[List,{
{Black,Blue,Red}[[densityShown]], (* dots *)
 lopPoints/@ Transpose[({
Point[{#[[1]]+0.07λ(fRight[#[[1]],t]+Boole[end≠"none"] fLeft[#[[1]],t]),#[[2]]}],
Point[{#[[1]]+0.07λ fRight[#[[1]],t],#[[2]]}],
Point[{#[[1]]+0.07λ fLeft[#[[1]],t],#[[2]]}]
}[[densityShown]])& /@ pts]
}]},
(* longitudinal envelope display: *)
If[end==="none",{},{
If[MemberQ[options,7],hArrows[n,L,λ,end],{}],
(* node & antinode labels: *)
If[MemberQ[options,9],dlabels[n,L,λ,end],{}],
If[MemberQ[options,10],plabels[n,L,λ,end],{}]
}]
}],{1550,350}]],
{{n,3,Row[{"harmonic ",Style["n",Italic]}]
},Range[7],ControlType->Setter},
{{end,"open","pipe end"},{"open","closed","none"}},
{{options,{2,4,5}},{
1->Tooltip["  +  ","standing wave: sum of left and right waves"],
2->Tooltip["  ->  ","wave moving right"],
3->Tooltip["  ←  ","wave reflected back left"],
4->Tooltip["  |||||  ","longitudinal contours"],(*7*)
5->Tooltip["  ⋮⋮⋮⋮⋮  ","longitudinal density"],(*8*)
6->Tooltip[transverseIcon,"transverse wave"],(*5*)
7->Tooltip[" ≡≡ ","longitudinal envelope"],(*6*)
8->Tooltip[" ⋰⋱ ","transverse envelope"], (*4*)
9->Tooltip["displacement nodes","show displacement nodes and antinodes"],
10->Tooltip["pressure nodes","show pressure nodes and antinodes"]
},ControlType->TogglerBar},
(* {{t,0,"time t"},0,1}, *)
{{t,0,Row[{"time ", Style["t",Italic]}]},0,1,ControlType->Trigger,AnimationRepetitions->∞,AppearanceElements->{"PlayPauseButton","FasterSlowerButtons"}},
TrackedSymbols:>{t,n,options,end},SaveDefinitions->True,
AutorunSequencing->{1,2,4},ControlPlacement->Top]

transversal

λ=1;
T=1;
caption[n_]:={
{"standing wave:   ",Row[{Style["y",Italic]," =  "}],TraditionalForm@HoldForm[Sin[2π((x/λ)-(("t")/T))]]," + ",TraditionalForm@HoldForm[Sin[2π((x/λ)+(("t")/T))]],"  =  ",TraditionalForm@HoldForm[2Sin[((2 π x)/λ)]],TraditionalForm@HoldForm[Cos[((2 π "t")/T)] ]},
{"traveling right:   ",Row[{Style["y",Italic]," =  "}],TraditionalForm@HoldForm[Sin[2π((x/λ)-(("t")/T))]]},
{"traveling left:   ",Row[{Style["y",Italic]," =  "}],"","",TraditionalForm@HoldForm[Sin[2π((x/λ)+(("t")/T))]]},
{"wave envelope:   ",Row[{Style["y",Italic]," =  "}],"","","","",TraditionalForm@HoldForm[±2 Sin[((2 π x)/λ)]]}}

caption2[n_]:={{TraditionalForm@HoldForm[L]," = ",n,DisplayForm@RowBox[{"(",FractionBox["λ","2"],")"}]
,"   ↔   ",TraditionalForm@HoldForm[λ]," = ",TraditionalForm@ ((HoldForm[2L])/n)}};

Manipulate[
Column[{
Plot[Evaluate[{
2Cos[((2 π t)/T)] Sin[((2 π x)/λ)],Sin[2π((x/λ)-(t/T))],Sin[2π((x/λ)+(t/T))],
{{2Sin[((2 π x)/λ)],-2Sin[((2 π x)/λ)]}}}[[options/. _?(#>4&)->Sequence[]]]],
{x,0,n λ/2},PlotRange->{{0-.01,n λ/2+.01},2{-2,2}},AspectRatio->0.15,Axes->{True,False},
PlotStyle->({
Directive[Dashing[{}],Thick,Black],Directive[Dashing[{}],Blue],Directive[Dashing[{}],Red],
Directive[Dotted,Gray],Directive[Dotted,Gray]}[[Flatten[options /. {4->{4,4},_?(#>4&)->Sequence[]}]]]),
Ticks->{{#λ,#"λ"}&/@ Range[1/2,5,1/2],None},Filling->If[MemberQ[options,5],Axis,None],
Prolog->{PointSize[.015],Point/@{{0,0},{n λ/2,0}}},
Epilog->
If[MemberQ[options,6],{Thickness[Tiny],Arrowheads[Tiny],
Table[{{Black,Arrow[{x,2Cos[((2 π t)/T)] Sin[((2 π x)/λ)]+#}& /@
 {0,-0.2((4 π )/T)Sin[((2 π t)/T)] Sin[((2 π x)/λ)]}]},
{Blue,Arrow[{x,Sin[2π((x/λ)-(t/T))]+#}& /@{0,-0.2((2π )/T)Cos[2π((x/λ)-(t/T))]}]},
{Red,Arrow[{x,Sin[2π((x/λ)+(t/T))]+#}& /@ {0,0.2((2π )/T)Cos[2π((x/λ)-(t/T))]}]}}[[options/. _?(#>3&)->Sequence[]]],{x,0,n λ/2,n λ/100}]},{}],
ImageSize->{1250,200}],
Dynamic@Pane[
Text@Column[{
TraditionalForm@Grid [caption[n][[Flatten[Sort[options/. _?(#>4&)->{}]]]],Alignment->Left,Spacings->{0,1}],
TraditionalForm@Grid [caption2[n]]
},Spacings->2],{1250,200}]}],
{{n,1,"harmonic n"},1,10,1,Appearance->"Labeled"},{{options,{1}},{1->Tooltip[" ↔ ","standing wave: sum of left and right waves"],2->Tooltip[" -> ","wave moving right"],3->Tooltip[" ← ","wave moving left"],4->Tooltip[" ⋰⋱ ","wave envelope"],5->Tooltip["  ■  ","shading"],6->Tooltip["  ↕  ","velocity vectors showing motion of string"]},ControlType->TogglerBar},
 {{t,0,"time t"},0,∞,ControlType->Trigger,AppearanceElements->{"PlayPauseButton","ResetButton","FasterSlowerButtons"}},
TrackedSymbols:>{options,t,n},AutorunSequencing->{1,3},SaveDefinitions->True]

The propagation of the generic disturbance, i.e., the “wave”: MyFunction

MyFunction[x_,β_]:=Log[β x];
(Subscript[β, 0])=1.2;

Animate[
Plot[{MyFunction[x,(Subscript[β, 0])],MyFunction[x+t,(Subscript[β, 0])]},{x,-5 π,5 π},AxesLabel->{Style["x",FontSize->24],Style["f(x)",FontSize->24]},PlotLegends->{Style["f(x) = ((sin (βx))/(βx))",FontSize->24],Style["f(x-t)",FontSize->24]},PlotRange->All,ImageSize->{1200,900},Mesh->Full]
,{t,0,10},AnimationRunning->False
]