linalg=<<linalg-wav.m;

ListPlot[linalg,PlotRange->{-1,1}]

ListPlot[Re[Fourier[linalg]],PlotRange->{-1,1}]

ListPlay[linalg,SampleRate->45000]

Entrauschen

linalgnoise=linalg+RandomVariate[NormalDistribution[0,.05],{Length[linalg]}];

ListPlot[linalgnoise,PlotRange->{-1,1}]

ListPlot[Re[Fourier[linalgnoise]],PlotRange->{-1,1}]

ListPlay[linalgnoise,SampleRate->45000]

(* denoise 1st attempt: cut off high frequencies from whole signal. doesnt work so well *)

denoise1[signal_] := Re[InverseFourier[Fourier[signal]*Table[If[i≤.06Length[signal],1,0],{i,1,Length[signal]}]]]

ListPlay[denoise1[linalgnoise],SampleRate->45000]

(* denoise 2nd attempt: same, but with smaller junks of the signal *)

denoise2[signal_]:=Flatten[denoise1/@Partition[signal,200]]

ListPlay[denoise2[linalgnoise],SampleRate->45000]

(* denoise 3rd attempt: convolution with a bell shape *)
bell=Table[Exp[-1/25(x-25)^2],{x,0,50}];
denoise3[signal_]:=Re[InverseFourier[Fourier[Join[0*bell,signal]]*Fourier[Join[bell,0*signal]]]]

ListPlay[denoise3[linalgnoise],SampleRate->45000]

(* denoise 4th attempt: round small amplitudes to zero *)
denoise4[signal_]:=Re[InverseFourier[If[Abs[#]<.1,0,#]&/@Fourier[signal]]]

ListPlay[denoise4[linalgnoise],SampleRate->45000]

Langsamer und schneller

stretch[list_] := Riffle[#,Most[ (# + RotateLeft[#,1])/2]]&[list];
shrink[list_]:=Table[list[[2i-1]],{i,1,Length[list]/2}];

ListPlay[stretch[linalg],SampleRate->45000]

ListPlay[Join@@(Re[InverseFourier[Take[stretch[Fourier[#]],200]]]& /@ Partition[stretch[linalg],200]),SampleRate->45000]

ListPlay[denoise3[Join@@(Re[InverseFourier[Take[stretch[Fourier[#]],200]]]& /@ Partition[stretch[linalg],200])],SampleRate->45000]

ListPlay[shrink[linalg],SampleRate->45000]

ListPlay[Join@@(Re[InverseFourier[PadRight[shrink[Fourier[#]],500]]]& /@ Partition[shrink[linalg],500]),SampleRate->45000]

ListPlay[denoise3[Join@@(Re[InverseFourier[PadRight[shrink[Fourier[#]],500]]]& /@ Partition[shrink[linalg],500])],SampleRate->45000]

Echo/Hall

pattern=Table[0,{20000}];pattern[[1]]=1;pattern[[10000]]=.333;pattern[[20000]]=.25;

ListPlay[Re[InverseFourier[Fourier[Join[linalg,0*pattern]]*Fourier[Join[pattern,0*linalg]]]],SampleRate->45000]

Spracherkennung

a=<<a-wav.m;

ListPlay[a,SampleRate->45000]

ListPlot[linalg/Min[Sum[RotateRight[Abs[linalg],k],{k,0,40}]],PlotRange->1]

ListPlot[data=Drop[Abs[InverseFourier[Fourier[Join[0*#,denoise1[linalg]]]*Fourier[Join[Reverse[denoise1[#]],0*linalg]]]]/Min[Sum[RotateRight[Abs[Join[#,linalg]],k],{k,0,40}]],Length[#]]&[a]]

Flatten[Position[data,#]&/@Take[Reverse[Sort[data]],20]]

Union[Floor[%/1000]1000]

ListPlay[linalg[[#-2500;;#+2500]]&[17000],SampleRate->45000]

ListPlay[linalg[[#-2500;;#+2500]]&[26000],SampleRate->45000]

ListPlay[linalg[[#-2500;;#+2500]]&[47000],SampleRate->45000]