Mathematicaの離散フーリエ変換

テキストの例題1(p.108)

x = {3, 0, -3, 0};   
Chop[
      Fourier[x, FourierParameters -> {-1, -1}]]

Chop[
      InverseFourier[%, 
        FourierParameters -> {-1, -1}]]

テキストの例題2(p.109)

\(x = {1, 1, \(-1\), \(-1\)}; \  (*\ x\_n\ *) 

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

Chop[
      InverseFourier[%, 
        FourierParameters -> {-1, -1}]]

テキストの例題3(p.110)

\(x = {2, 0, 2, 0}; \  (*\ x\_n\ *) 

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

Chop[
      InverseFourier[%, 
        FourierParameters -> {-1, -1}]]

サンプリング

準備

SetDirectory["z:"];

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

x = 
        Take[org, {1, 8000}];

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

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

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

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

いろいろな周波数の音を聴いてみる

f = 
        20;

    Play[Sin[2 Pi f t], {t, 0, 3}, SampleRate -> 8000, 
      PlayRange -> All]

f = 
        27.5;

    Play[Sin[2 Pi f t], {t, 0, 3}, SampleRate -> 8000, 
      PlayRange -> All]

f = 440;

    Play[Sin[2 Pi f t], {t, 0, 3}, SampleRate -> 8000, 
      PlayRange -> All]

f = 
        880;

    Play[ Sin[2 Pi f t], {t, 0, 3}, SampleRate -> 8000, 
      PlayRange -> All]

f = 
        1000;

    Play[ Sin[2 Pi f t], {t, 0, 3}, SampleRate -> 8000, 
      PlayRange -> All]

f = 
        2000;

    Play[ Sin[2 Pi f t], {t, 0, 3}, SampleRate -> 8000, 
      PlayRange -> All]

f = 
        4096;

    Play[ Sin[2 Pi f t], {t, 0, 3}, SampleRate -> 8000, 
      PlayRange -> All]

いろいろな周波数の音を作ってみる

x0 = 
        Table[0, {t, 0, 0.8, 0.000125}];

    x1 = 
        Table[Sin[2 Pi 440 t], {t, 0, 0.2, 
            0.000125}];

    x2 = 
        Table[(-0.5 t + 1)* Sin[2 Pi 880 t], {t, 0, 2, 
            0.000125}];

    ListPlay[Join[x1, x0, x1, x0, x1, x0, x2], SampleRate -> 8000, 
      PlayRange -> All]

\(\(\( (*\ 不通電話\ *) \)\(
\)\(\(x0 = 
        Table[0, {t, 0, 0.5, 0.000125}];\)

    \(x1 = 
        Table[Sin[2\ Pi\ 440\ t], {t, 0, 0.5, 
            0.000125}];\)

    ListPlay[Join[x0, x1, x0, x1, x0, x1, x0, x1, x0, x1, x0, x1], 
      SampleRate -> 8000, PlayRange -> All]\)\)\)

電話のトーン信号

\(電話のト - ン信号は\),下表のように,低い周波数と高い周波数の組み合わせによって構成される
({{□, 1209  Hz, 1336  Hz, 1477  Hz}, {697  Hz, 1, 2, 3}, {770  Hz, 4, 5, 6}, {852  Hz, 7, 8, 9}, {941  Hz, *, 0, #}})

sp = 
        Table[0, {t, 0, 0.05, 0.000125}];

x1 = 
        Table[Sin[2 Pi 697 t] + Sin[2 Pi 1209 t], {t, 0, 0.1, 
            0.000125}];

    x1 = Join[sp, x1, sp];

    ListPlay[x1, SampleRate -> 8000, 
      PlayRange -> {-2, 2}]

x2 = 
        Table[Sin[2 Pi 697 t] + Sin[2 Pi 1336 t], {t, 0, 0.1, 
            0.000125}];

    x2 = Join[sp, x2, sp];

    ListPlay[x2, SampleRate -> 8000, 
      PlayRange -> {-2, 2}]

x3 = 
        Table[Sin[2 Pi 697 t] + Sin[2 Pi 1477 t], {t, 0, 0.1, 
            0.000125}];

    x3 = Join[sp, x3, sp];

    ListPlay[x3, SampleRate -> 8000, 
      PlayRange -> {-2, 2}]

x4 = 
        Table[Sin[2 Pi 770 t] + Sin[2 Pi 1209 t], {t, 0, 0.1, 
            0.000125}];

    x4 = Join[sp, x4, sp];

    ListPlay[x4, SampleRate -> 8000, 
      PlayRange -> {-2, 2}]

x5 = 
        Table[Sin[2 Pi 770 t] + Sin[2 Pi 1336 t], {t, 0, 0.1, 
            0.000125}];

    x5 = Join[sp, x5, sp];

    ListPlay[x5, SampleRate -> 8000, 
      PlayRange -> {-2, 2}]

x6 = 
        Table[Sin[2 Pi 770 t] + Sin[2 Pi 1477 t], {t, 0, 0.1, 
            0.000125}];

    x6 = Join[sp, x6, sp];

    ListPlay[x6, SampleRate -> 8000, 
      PlayRange -> {-2, 2}]

\(\(\( (*\ ト - ン信号[
          7]\ *) \)\(
\)\(\(x7 = 
        Table[Sin[2\ Pi\ 852\ t] + Sin[2\ Pi\ 1209\ t], {t, 0, 0.1, 
            0.000125}];\)

    \(x7 = Join[sp, x7, sp];\)

    ListPlay[x7, SampleRate -> 8000, 
      PlayRange -> {\(-2\), 2}]\)\)\)

x8 = 
        Table[Sin[2 Pi 852 t] + Sin[2 Pi 1336 t], {t, 0, 0.1, 
            0.000125}];

    x8 = Join[sp, x8, sp];

    ListPlay[x8, SampleRate -> 8000, 
      PlayRange -> {-2, 2}]

x9 = 
        Table[Sin[2 Pi 852 t] + Sin[2 Pi 1477 t], {t, 0, 0.1, 
            0.000125}];

    x9 = Join[sp, x9, sp];

    ListPlay[x9, SampleRate -> 8000, 
      PlayRange -> {-2, 2}]

x0 = 
        Table[Sin[2 Pi 941 t] + Sin[2 Pi 1336 t], {t, 0, 0.1, 
            0.000125}];

    x0 = Join[sp, x0, sp];

    ListPlay[x0, SampleRate -> 8000, 
      PlayRange -> {-2, 2}]

\(\(\( (*\ 時報117に電話する\ *) \)\(
\)\(\(x = Join[x1, x1, x7];\)

    ListPlay[x, SampleRate -> 8000, 
      PlayRange -> {\(-2\), 2}]\)\)\)

\(\(\( (*\ ファイルへの書き出し\ *) \)\(
\)\(Export["tel117.wav", 
Sound[
          SampledSoundList[x, 8000]], "WAV"];\)\)\)

離散フーリエ変換

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

ListPlot[Re[lx], 
        PlotRange -> {Automatic, {Min[Re[lx]], 
              Max[Re[lx]]}}];

ListPlot[Im[lx], 
        PlotRange -> {Automatic, {Min[Im[lx]], 
              Max[Im[lx]]}}];

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

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

離散フーリエ積分

\(\(\( (*\ 離散フ - リエ積分\ *) \)\(
\)\(x = 
        Chop[Re[
InverseFourier[lx, 
              FourierParameters -> {\(-1\), \(-1\)}]]];\)\)\)

\(\(\( (*\ 離散フ - リエ積分後の波の確認\ *) \)\(
\)\(ListPlot[x, 
        PlotRange -> {Automatic, {\(-1\), 1}}];\)\)\)

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

\(\(\( (*\ ファイルへの書き出し\ *) \)\(
\)\(Export["output.wav", 
Sound[
          SampledSoundList[x, 8000]], "WAV"];\)\)\)

自分の声は？

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

x = 
        Take[org, {1, 8000}];

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

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

ListPlay[x, 
        SampleRate -> 4000];

ListPlay[x, 
        SampleRate -> 16000];

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

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

\(\(\( (*\ 周波数スペクトル密度のグラフ \((\(絶対値 &\) 拡大)\)\ *) \)\(
\)\(ListPlot[Abs[lx], 
        PlotRange -> {{1, 2000}, {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]"];