Histogram częstotliwoci

Š Marek Szczerba, 2000

<< Miscellaneous`Audio`<< Graphics`Graphics`<< CCRMA`SCMTheory`<< CCRMA`Windows`;

SetDirectory["D:\Mathematica\data"];

src = ReadSoundfile["example.wav"];

wind = HammingW[Length[src]];

snd = src*wind;

padfct = 1;

zeros = Table[0, {x, padfct*Length[src]}];

AppendTo[snd, zeros]; snd = Flatten[snd];

spectrum = Abs[Fourier[snd]];

spectrum = 
      Table[spectrum[[x]], {x, 
          Length[spectrum]/2}];

ListPlot[spectrum, PlotRange -> All, Frame -> False, 
      PlotJoined -> True, PlotStyle -> RGBColor[0, 0, 1], Ticks -> Automatic, 
      FrameTicks -> Automatic];

Znalezienie maksimów widma powyżej progu (Thr)

\(Thr = 1000; 
Loc = {}; 
Mxs = Table[0, {x, Length[spectrum]}]; 

    For[x = 2, x < Length[spectrum], \(x++\), 
	
      If[spectrum[[x]] > Thr && 
          spectrum[[x]] > 
            spectrum[[x - 1]] && 
          spectrum[[x]] > 
            spectrum[[x + 1]], 
			
        Mxs[[x]] = 1; 
			
        AppendTo[Loc, x]; 
	]
]; \)

Maksima

Loc

BarChart[Mxs, PlotRange -> All, Frame -> True, 
      BarStyle -> {RGBColor[0, 0, 1], RGBColor[0, 0, 1]}, BarEdges -> False, 
      Axes -> None, Ticks -> {None,  Automatic}, 
      FrameTicks -> {Automatic, None}];

Obliczenie stosunku najwyższej do najniższej częstotliwoci maksimów

MaxRel = 
      Ceiling[Loc[[Length[Loc]]]/Loc
            [[1]]]

Dzielenie kolejnych częstotliwoci pršżków

\(Hist = Table[0, {x, Length[Loc]}]; 

    For[i = 1, \ i < Length[Loc], \(i++\), 
	
      For[j = 2, \ j <= MaxRel, \ \(j++\), 
			
        For[k = i + 1, k <= Length[Loc], \(k++\), 
				
          If[Abs[Loc[[k]]\/j - 
                    Loc[[i]]] < 1 || 
              Abs[\(Loc[[k]] - 1\)\/j - 
                    Loc[[i]]] < 1 || 
              Abs[\(Loc[[k]] + 1\)\/j - 
                    Loc[[i]]] < 1, 
            \(Hist[[i]]++\)]
		]

        		]
]; 
Hist\)

Wywietlenie wyników

BarChart[Hist, PlotRange -> All, Frame -> True, 
      BarStyle -> {RGBColor[0, 0, 1], RGBColor[0, 0, 1]}, BarEdges -> True, 
      Axes -> None, FrameTicks -> Automatic];

\(\(
x = 1; 
Histogram = Table[0, {z, Length[Mxs]}]; 

    For[i = 1, i < Length[Mxs], \(i++\), 
	
      If[i == Loc[[x]], 
        Histogram[[i]] = 
          Hist[[x]]; \(x++\)]]; \)\)

BarChart[Histogram, PlotRange -> All, Frame -> True, 
      BarStyle -> {RGBColor[0, 0, 1], RGBColor[0, 0, 1]}, BarEdges -> False, 
      Axes -> None, Ticks -> {None,  Automatic}, FrameTicks -> Automatic];