音の主成分

準備

SetDirectory["z:"];

org = Import["a.wav", "WAV"][[1, 
            1]];

ListPlot[org, 
        PlotRange -> {{0, 8000}, {-1, 1}}];

\(\(\( (*\ 音声を聞いてみる\ *) \)\(
\)\(ListPlay[org, SampleRate -> 8000, 
      PlayRange -> All]\)\)\)

ピーク(1)

\(\(\( (*\ 離散フ - リエ変換\ *) \)\(
\)\(\(x = org;\)

    \(lx = 
        Chop[
Fourier[x, 
            FourierParameters -> {\(-1\), \(-1\)}]];\)\)\)\)

\(\(\( (*\ 周波数スペクトル密度のグラフ \((絶対値)\)\ *) \)\(
\)\(ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];\)\)\)

Print["\
\:7d76\:5bfe\:5024\:306e\:6700\:5927\:5024:", 
        Max[Abs[lx]]];

    Print["\:6700\:5927\:5024\:306e\:4f4d\:7f6e:", Position[Abs[lx], 
              Max[Abs[lx]]][[1, 1]] - 1];

    Print["\:6700\:5927\:5024\:306e\:5468\:6ce2\:6570:", 
        N[(Position[Abs[lx], Max[Abs[lx]]][[1, 1]] - 
                1)/(Length[lx]/8000)], "[Hz]"];

\(\(\( (*\ 周波数スペクトル密度のグラフ \((\(絶対値 &\) 拡大)\)\ *) \)\(
\)\(ListPlot[Abs[lx], 
        PlotRange -> {{600, 1000}, {0, Max[Abs[lx]]}}];\)\)\)

For[
        i = 1, i ≤ 
          630, i++, 
lx[[i]] = 
            0;   
];

    For[i = 852, 
        i ≤ 4001, i++, 
lx[[i]] = 
          0;    
];

    For[i = 8000, 
        i ≥ 7372, i--, 
lx[[i]] = 
          0;    
];

    For[i = 7150, 
        i ≥ 4002, i--, 
lx[[i]] = 
          0;    
];

ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];

ListPlot[Abs[lx], 
        PlotRange -> {{0, 1000}, {0, Max[Abs[lx]]}}];

x = 
        Chop[
Re[
            InverseFourier[lx, 
              FourierParameters -> {-1, -1}]]];

\(\(\( (*\ 抽出後の波の確認\ *) \)\(
\)\(ListPlot[x, 
        PlotRange -> {{0, 8000}, {\(-1\), 1}}];\)\)\)

ListPlay[x, 
        SampleRate -> 8000, PlayRange -> All];

ListPlay[org, 
        SampleRate -> 8000, PlayRange -> All];

ピーク(2)

\(\(\( (*\ 離散フ - リエ変換\ *) \)\(
\)\(\(x = org;\)

    \(lx = 
        Chop[
Fourier[x, 
            FourierParameters -> {\(-1\), \(-1\)}]];\)\)\)\)

\(\(\( (*\ 周波数スペクトル密度のグラフ \((絶対値)\)\ *) \)\(
\)\(ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];\)\)\)

\(\(\( (*\ 周波数スペクトル密度のグラフ \((\(絶対値 &\) 拡大)\)\ *) \)\(
\)\(ListPlot[Abs[lx], 
        PlotRange -> {{0, 1000}, {0, Max[Abs[lx]]}}];\)\)\)

For[
        i = 1, i ≤ 
          450, i++, 
lx[[i]] = 
            0;   
];

    For[i = 622, 
        i ≤ 4001, i++, 
lx[[i]] = 
          0;    
];

    For[i = 8000, 
        i ≥ 7552, i--, 
lx[[i]] = 
          0;    
];

    For[i = 7380, 
        i ≥ 4002, i--, 
lx[[i]] = 
          0;    
];

ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];

ListPlot[Abs[lx], 
        PlotRange -> {{0, 1000}, {0, Max[Abs[lx]]}}];

x = 
        Chop[
Re[
            InverseFourier[lx, 
              FourierParameters -> {-1, -1}]]];

\(\(\( (*\ 抽出後の波の確認\ *) \)\(
\)\(ListPlot[x, 
        PlotRange -> {{0, 8000}, {\(-1\), 1}}];\)\)\)

ListPlay[x, 
        SampleRate -> 8000, PlayRange -> All];

ListPlay[org, 
        SampleRate -> 8000, PlayRange -> All];

ピーク(3)

\(\(\( (*\ 離散フ - リエ変換\ *) \)\(
\)\(\(x = org;\)

    \(lx = 
        Chop[
Fourier[x, 
            FourierParameters -> {\(-1\), \(-1\)}]];\)\)\)\)

\(\(\( (*\ 周波数スペクトル密度のグラフ \((絶対値)\)\ *) \)\(
\)\(ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];\)\)\)

\(\(\( (*\ 周波数スペクトル密度のグラフ \((\(絶対値 &\) 拡大)\)\ *) \)\(
\)\(ListPlot[Abs[lx], 
        PlotRange -> {{0, 1000}, {0, Max[Abs[lx]]}}];\)\)\)

For[
        i = 1, i ≤ 
          300, i++, 
lx[[i]] = 
            0;   
];

    For[i = 452, 
        i ≤ 
          4001, i++, 
lx[[i]] = 
          0;    
];

    For[i = 8000, 
        i ≥ 
          7702, i--, 
lx[[i]] = 
          0;    
];

    For[i = 7550, 
        i ≥ 
          4002, i--, 
lx[[i]] = 
          0;    
];

ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];

ListPlot[Abs[lx], 
        PlotRange -> {{0, 1000}, {0, Max[Abs[lx]]}}];

x = 
        Chop[
Re[
            InverseFourier[lx, 
              FourierParameters -> {-1, -1}]]];

\(\(\( (*\ 抽出後の波の確認\ *) \)\(
\)\(ListPlot[x, 
        PlotRange -> {{0, 8000}, {\(-1\), 1}}];\)\)\)

ListPlay[x, 
        SampleRate -> 8000, PlayRange -> All];

ListPlay[org, 
        SampleRate -> 8000, PlayRange -> All];

"あいうえお"の比較

\(\(\( (*\ ファイルの読み込み\ *) \)\(
\)\(\(xa = \(Import["a.wav", "WAV"]\)[\([\)\(1, 1\)\(]\)];\)

    \(xi = \(Import["i.wav", "WAV"]\)[\([1, 
            1]\)];\)

    \(xu = \(Import["u.wav", "WAV"]\)[\([1, 
            1]\)];\)

    \(xe = \(Import["e.wav", "WAV"]\)[\([1, 1]\)];\)

    \(xo = \(Import["o.wav", "WAV"]\)[\([1, 1]\)];\)\)\)\)

\(\(\( (*\ 波の確認\ *) \)\(
\)\(\(ListPlot[xa, 
        PlotRange -> {{0, 8000}, {\(-1\), 1}}];\)

    \(ListPlot[xi, 
        PlotRange -> {{0, 8000}, {\(-1\), 1}}];\)

    \(ListPlot[xu, 
        PlotRange -> {{0, 8000}, {\(-1\), 1}}];\)

    \(ListPlot[xe, PlotRange -> {{0, 8000}, {\(-1\), 1}}];\)

    \(ListPlot[xo, 
        PlotRange -> {{0, 8000}, {\(-1\), 1}}];\)\)\)\)

\(\(\( (*\ 音声を聞いてみる\ *) \)\(
\)\(ListPlay[xa, SampleRate -> 8000, 
        PlayRange -> All];\)\)\)

ListPlay[xi, SampleRate -> 8000, 
        PlayRange -> All];

ListPlay[xu, SampleRate -> 8000, 
        PlayRange -> All];

ListPlay[xe, SampleRate -> 8000, 
        PlayRange -> All];

ListPlay[xo, SampleRate -> 8000, 
        PlayRange -> All];

\(\(\( (*\ 離散フ - リエ変換\ *) \)\(
\)\(\(lxa = 
        Chop[
Fourier[xa, 
            FourierParameters -> {\(-1\), \(-1\)}]];\)

    \(lxi = 
        Chop[
Fourier[xi, 
            FourierParameters -> {\(-1\), \(-1\)}]];\)

    \(lxu = 
        Chop[
Fourier[xu, 
            FourierParameters -> {\(-1\), \(-1\)}]];\)

    \(lxe = 
        Chop[
Fourier[xe, 
            FourierParameters -> {\(-1\), \(-1\)}]];\)

    \(lxo = 
        Chop[
Fourier[xo, 
            FourierParameters -> {\(-1\), \(-1\)}]];\)\)\)\)

\(\(\( (*\ "あ" の周波数スペクトル密度のグラフ \((絶対値)\)\ *) \)\(
\)\(ListPlot[Abs[lxa], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lxa]]}}];\)\)\)

\(\(\( (*\ "い" の周波数スペクトル密度のグラフ \((絶対値)\)\ *) \)\(
\)\(ListPlot[Abs[lxi], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lxi]]}}];\)\)\)

\(\(\( (*\ "う" の周波数スペクトル密度のグラフ \((絶対値)\)\ *) \)\(
\)\(ListPlot[Abs[lxu], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lxu]]}}];\)\)\)

\(\(\( (*\ "え" の周波数スペクトル密度のグラフ \((絶対値)\)\ *) \)\(
\)\(ListPlot[Abs[lxe], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lxe]]}}];\)\)\)

\(\(\( (*\ "お" の周波数スペクトル密度のグラフ \((絶対値)\)\ *) \)\(
\)\(ListPlot[Abs[lxo], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lxo]]}}];\)\)\)

ListPlot[Abs[lxa], 
        PlotRange -> {{0, 1000}, {0, Max[Abs[lxa]]}}];

ListPlot[Abs[lxi], 
        PlotRange -> {{0, 1000}, {0, Max[Abs[lxi]]}}];

ListPlot[Abs[lxu], 
        PlotRange -> {{0, 1000}, {0, Max[Abs[lxu]]}}];

ListPlot[Abs[lxe], 
        PlotRange -> {{0, 1000}, {0, Max[Abs[lxe]]}}];

ListPlot[Abs[lxo], 
        PlotRange -> {{0, 1000}, {0, Max[Abs[lxo]]}}];

ノイズ除去

準備

SetDirectory["z:"];

org = Import["a.wav", "WAV"][[1, 
            1]];

ListPlot[org, 
        PlotRange -> {{0, 8000}, {-1, 1}}];

\(\(\( (*\ 音声を聞いてみる\ *) \)\(
\)\(ListPlay[org, SampleRate -> 8000, 
        PlayRange -> All];\)\)\)

ノイズ部分の調査

xd = Take[org, {1, 2000}];

ListPlot[xd, 
        PlotRange -> {{0, 2000}, {-0.02, 0.02}}, 
        PlotJoined -> True];

lxd = 
        Chop[Fourier[xd, 
            FourierParameters -> {-1, -1}]];

ListPlot[Abs[lxd], 
        PlotRange -> {{0, 2000}, {0, 0.008}}];

Print["\
\:7d76\:5bfe\:5024\:306e\:6700\:5927\:5024:", 
        Max[Abs[lxd]]];

    Print["\:6700\:5927\:5024\:306e\:4f4d\:7f6e:", Position[Abs[lxd], 
              Max[Abs[lxd]]][[1, 1]] - 1];

    Print["\:6700\:5927\:5024\:306e\:5468\:6ce2\:6570:", 
        N[(Position[Abs[lxd], Max[Abs[lxd]]][[1, 1]] - 
                1)/(Length[lxd]/8000)], "[Hz]"];

ListPlot[Abs[lxd], 
        PlotRange -> {{0, 50}, {0, 0.008}}, 
        PlotStyle -> PointSize[0.03]];

ノイズ除去(1)

\(\(\( (*\ 離散フ - リエ変換\ *) \)\(
\)\(\(x = org;\)

    \(lx = 
        Chop[
Fourier[x, 
            FourierParameters -> {\(-1\), \(-1\)}]];\)\)\)\)

\(\(\( (*\ 周波数スペクトル密度のグラフ \((絶対値)\)\ *) \)\(
\)\(ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];\)\)\)

\(\(\( (*\ ノイズ除去 \((1)\)\ *) \)\(
\)\(\(lx[\([60 + 1]\)] = 
        0;\)\  (*\ 正の周波数\ *) 

    \(\(\(lx[\([\((8000 - 60)\) + 1]\)] = 
        0\) \)\(;\)\(\ \)\( (*\ 負の周波数\ *) \)\)\)\)\)

ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];

x = 
        Chop[
Re[
            InverseFourier[lx, 
              FourierParameters -> {-1, -1}]]];

ListPlot[x, 
        PlotRange -> {{0, 8000}, {-1, 1}}];

ListPlay[x, 
        SampleRate -> 8000, PlayRange -> All];

ListPlay[org, 
        SampleRate -> 8000, PlayRange -> All];

ノイズ除去(2)

\(\(\( (*\ 離散フ - リエ変換\ *) \)\(
\)\(\(x = org;\)

    \(lx = 
        Chop[
Fourier[x, 
            FourierParameters -> {\(-1\), \(-1\)}]];\)\)\)\)

\(\(\( (*\ 周波数スペクトル密度のグラフ \((絶対値)\)\ *) \)\(
\)\(ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];\)\)\)

\(\(\( (*\ ノイズ除去 \((2)\)\ *) \)\(
\)\(\(For[i = 1501, 
        i ≤ 4001, \(i++\), 
lx[\([i]\)] = 
          0\  (*\ 正の周波数\ *) 
];\)

    \(For[i = 4002, 
        i ≤ 6501, \(i++\), 
lx[\([i]\)] = 
          0\  (*\ 負の周波数\ *) 
];\)\)\)\)

ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];

x = 
        Chop[
Re[
            InverseFourier[lx, 
              FourierParameters -> {-1, -1}]]];

ListPlot[x, 
        PlotRange -> {Automatic, {-1, 1}}];

ListPlay[x, 
        SampleRate -> 8000, PlayRange -> All];

ListPlay[org, 
        SampleRate -> 8000, PlayRange -> All];

ボイスチェンジャー

準備

SetDirectory["z:"];

org = Import["a.wav", "WAV"][[1, 
            1]];

ListPlot[org, 
        PlotRange -> {{0, 8000}, {-1, 1}}];

\(\(\( (*\ 音声を聞いてみる\ *) \)\(
\)\(ListPlay[org, SampleRate -> 8000, 
        PlayRange -> All];\)\)\)

低音から高音へ(1)

\(\(\( (*\ 離散フ - リエ変換\ *) \)\(
\)\(\(x = org;\)

    \(lx = 
        Chop[
Fourier[x, 
            FourierParameters -> {\(-1\), \(-1\)}]];\)\)\)\)

\(\(\( (*\ 周波数スペクトル密度のグラフ \((絶対値)\)\ *) \)\(
\)\(ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];\)\)\)

For[i = 3001, 
        i ≥ 1, i--, 
lx[[i + 1000]] = 
          lx[[i]];    
];

    For[i = 1, 
        i ≤ 1000, i++, 
lx[[i]] = 
          0;    
];

    For[i = 5002, 
        i ≤ 
          8000, i++, 
lx[[i - 1000]] = 
            lx[[i]];   
];

    For[i = 7001, 
        i ≤ 8000, i++, 
lx[[i]] = 
          0;    
];

ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];

x = 
        Chop[
Re[
            InverseFourier[lx, 
              FourierParameters -> {-1, -1}]]];

\(\(\( (*移動後の波の確認\ *) \)\(
\)\(ListPlot[x, 
        PlotRange -> {{0, 8000}, {\(-1\), 1}}];\)\)\)

ListPlay[x, 
        SampleRate -> 8000, PlayRange -> All];

ListPlay[org, 
        SampleRate -> 8000, PlayRange -> All];

高音から低音へ(1)

\(\(\( (*\ 離散フ - リエ変換\ *) \)\(
\)\(\(x = org;\)

    \(lx = 
        Chop[
Fourier[x, 
            FourierParameters -> {\(-1\), \(-1\)}]];\)\)\)\)

\(\(\( (*\ 周波数スペクトル密度のグラフ \((絶対値)\)\ *) \)\(
\)\(ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];\)\)\)

\(\(\( (*\ 高音から低音へ \((\(-500\) 
            Hz)\)\ *) \)\(
\)\(\(For[i = 501, 
        i ≤ 4501, \(i++\), 
lx[\([i - 500]\)] = 
          lx[\([i]\)]; \  (*\ 正の周波数\ *) 
];\)

    \(For[i = 3502, 
        i ≤ 4001, \(i++\), 
lx[\([i]\)] = 
          0;  (*\ 正の周波数\ *) 
];\)

    \(For[i = 7500, 
        i ≥ 
          4002, \(i--\), 
lx[\([i + 500]\)] = 
          lx[\([i]\)]; \  (*\ 負の周波数\ *) 
];\)

    \(For[i = 4002, 
        i ≤ 4501, \(i++\), 
lx[\([i]\)] = 
          0;  (*\ 負の周波数\ *) 
];\)\)\)\)

ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];

x = 
        Chop[
Re[
            InverseFourier[lx, 
              FourierParameters -> {-1, -1}]]];

\(\(\( (*移動後の波の確認\ *) \)\(
\)\(ListPlot[x, 
        PlotRange -> {{0, 8000}, {\(-1\), 1}}];\)\)\)

ListPlay[x, 
        SampleRate -> 8000, PlayRange -> All];

ListPlay[org, 
        SampleRate -> 8000, PlayRange -> All];

低音から高音へ(2)

\(\(\( (*\ 離散フ - リエ変換\ *) \)\(
\)\(\(x = org;\)

    \(lx = 
        Chop[
Fourier[x, 
            FourierParameters -> {\(-1\), \(-1\)}]];\)\)\)\)

\(\(\( (*\ ノイズ除去 \((2)\)\ *) \)\(
\)\(\(For[i = 1501, 
        i ≤ 4001, \(i++\), 
lx[\([i]\)] = 
          0\  (*\ 正の周波数\ *) 
];\)

    \(For[i = 4002, 
        i ≤ 6501, \(i++\), 
lx[\([i]\)] = 
          0\  (*\ 負の周波数\ *) 
];\)\)\)\)

\(\(\( (*\ 周波数スペクトル密度のグラフ \((絶対値)\)\ *) \)\(
\)\(ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];\)\)\)

\(\(\( (*\ 低音から高音へ \((\(+1000\) 
            Hz)\)\ *) \)\(
\)\(\(For[i = 3001, 
        i ≥ 1, \(i--\), 
lx[\([i + 1000]\)] = 
          lx[\([i]\)]; \  (*\ 正の周波数\ *) 
];\)

    \(For[i = 1, 
        i ≤ 1000, \(i++\), 
lx[\([i]\)] = 
          0;  (*\ 正の周波数\ *) 
];\)

    \(For[i = 5002, 
        i ≤ 
          8000, \(i++\), 
\(lx[\([i - 1000]\)] = 
            lx[\([i]\)];\)\  (*\ 負の周波数\ *) 
];\)

    \(For[i = 7001, 
        i ≤ 8000, \(i++\), 
lx[\([i]\)] = 
          0;  (*\ 負の周波数\ *) 
];\)\)\)\)

ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];

x = 
        Chop[
Re[
            InverseFourier[lx, 
              FourierParameters -> {-1, -1}]]];

\(\(\( (*移動後の波の確認\ *) \)\(
\)\(ListPlot[x, 
        PlotRange -> {{0, 8000}, {\(-1\), 1}}];\)\)\)

ListPlay[x, 
        SampleRate -> 8000, PlayRange -> All];

ListPlay[org, 
        SampleRate -> 8000, PlayRange -> All];

高音から低音へ(2)

\(\(\( (*\ 離散フ - リエ変換\ *) \)\(
\)\(\(x = org;\)

    \(lx = 
        Chop[
Fourier[x, 
            FourierParameters -> {\(-1\), \(-1\)}]];\)\)\)\)

\(\(\( (*\ ノイズ除去 \((2)\)\ *) \)\(
\)\(\(For[i = 1501, 
        i ≤ 4001, \(i++\), 
lx[\([i]\)] = 
          0\  (*\ 正の周波数\ *) 
];\)

    \(For[i = 4002, 
        i ≤ 6501, \(i++\), 
lx[\([i]\)] = 
          0\  (*\ 負の周波数\ *) 
];\)\)\)\)

\(\(\( (*\ 周波数スペクトル密度のグラフ \((絶対値)\)\ *) \)\(
\)\(ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];\)\)\)

\(\(\( (*\ 高音から低音へ \((\(-500\) 
            Hz)\)\ *) \)\(
\)\(\(For[i = 501, 
        i ≤ 4501, \(i++\), 
lx[\([i - 500]\)] = 
          lx[\([i]\)]; \  (*\ 正の周波数\ *) 
];\)

    \(For[i = 3502, 
        i ≤ 4001, \(i++\), 
lx[\([i]\)] = 
          0;  (*\ 正の周波数\ *) 
];\)

    \(For[i = 7500, 
        i ≥ 
          4002, \(i--\), 
lx[\([i + 500]\)] = 
          lx[\([i]\)]; \  (*\ 負の周波数\ *) 
];\)

    \(For[i = 4002, 
        i ≤ 4501, \(i++\), 
lx[\([i]\)] = 
          0; \  (*\ 負の周波数\ *) 
];\)\)\)\)

ListPlot[Abs[lx], 
        PlotRange -> {{0, 8000}, {0, Max[Abs[lx]]}}];

x = 
        Chop[
Re[
            InverseFourier[lx, 
              FourierParameters -> {-1, -1}]]];

\(\(\( (*移動後の波の確認\ *) \)\(
\)\(ListPlot[x, 
        PlotRange -> {{0, 8000}, {\(-1\), 1}}];\)\)\)

ListPlay[x, 
        SampleRate -> 8000, PlayRange -> All];

ListPlay[org, 
        SampleRate -> 8000, PlayRange -> All];