シェパードトーン(無限音階)アニメーションの作成
Shepard Tone (Infinite Musical Scale) Animation

2003/6/7 平野拓一（東京工業大学）
Takuichi Hirano (Tokyo Institute of Technology)

周波数を求める関数（平均律）

[Input]
オクターブ
音 (c,c#,d,d#,e,f,f#,g,g#,a,a#,b)

ABCToNumOfHalfTone[ABC_] := 
          Which[
ABC == "C"  ||  ABC == "c", 
            0, 
ABC == "C#"  ||  ABC == "c#", 
            1, 
ABC == "D"  ||  ABC == "d", 
            2, 
ABC == "D#"  ||  ABC == "d#", 
            3, 
ABC == "E"  ||  ABC == "e", 
            4, 
ABC == "F"  ||  ABC == "f", 
            5, 
ABC == "F#"  ||  ABC == "f#", 
            6, 
ABC == "G"  ||  ABC == "g", 
            7, 
ABC == "G#"  ||  ABC == "g#", 
            8, 
ABC == "A"  ||  ABC == "a", 
            9, 
ABC == "A#"  ||  ABC == "a#", 
            10, 
ABC == "B"  ||  ABC == "b", 
            11];

FreqTemperament[Octave_, ABC_]:=Module[{r = (2^(1/12))},
  
ABCNum = 
              ABCToNumOfHalfTone[
                ABC]; 
(440*(r^((Octave - 4)*12)))*
                (r^(ABCNum - 9))  // N
];
FreqTemperament[OctABCList_List] := 
        Map[(FreqTemperament[#[[1]], #[[2]]] &), 
          OctABCList];

Sine Weighting

<< Graphics`Graphics`;
n = 10;
r = (2^(1/12));
LevLow = 1;
envelope[cent_, ord_, 
          x_] := (LevLow + (((Cos[π*(x - cent)]))^ord));
sinList[cent_, ord_, x0_] := 
        N[ Table[{x0 + (i - 1)/(n - 
                      1), (LevLow + (((Cos[π*(x0 + (i - 1)/(n - 1) - cent)]))^ord))}, {i, 1, n}] ];

    
freq[1] = FreqTemperament[5, "C"];
freq[2] = FreqTemperament[5, "D"];
freq[3] = FreqTemperament[5, "E"];
freq[4] = FreqTemperament[5, "F"];
freq[5] = FreqTemperament[5, "G"];
freq[6] = FreqTemperament[5, "A"];
freq[7] = FreqTemperament[5, "B"];

    
x0 = 0.1*(freq[7]/freq[1] - 1);
lis0 = sinList[0.5, 2, 0];
lis = sinList[0.5, 2, x0];
\(Plot[
      envelope[0.5, 2, x], {x, 0, 
        1}, 
Epilog -> {{Dashing[{0.03, 0.03}], 
            AbsoluteThickness[2], RGBColor[1, 0.5, 1], 
            Map[\((Line[{{#[\([1]\)], 0}, {#[\([1]\)], #[\([2]\)]}}] &)\), 
              lis0]}, 
{AbsoluteThickness[2], 
            RGBColor[1, 0, 0], 
            Map[\((Line[{{#[\([1]\)], 0}, {#[\([1]\)], #[\([2]\)]}}] &)\), 
              lis]}, 
Prepend[
            Table[Text[\("2"\^ToString[
                        i - 1]\) \*""(Subscript[f, 0])"", {x0 + \((i - 
                          1)\)/\((n - 1)\), 0}, {\(-1\), \(-1\)}], {i, 3, 
                n}], {Text[\*""(Subscript[f, 0])"", {x0, 
                  0}, {\(-1\), \(-1\)}], 
              Text[\*""2(Subscript[f, 0])"", {x0 + \((2 - 1)\)/\((n - 1)\), 
                  0}, {\(-1\), \(-1\)}]}]}, 
PlotRange -> {{0, 1}, {0, 
            2.1}}, 
PlotStyle -> {Dashing[{0.03, 
              0.03}], AbsoluteThickness[2], 
          RGBColor[0.5, 0.5, 
            0.5]}, 
PlotLabel -> "B", 
ImageSize -> {320, 
          240}, 
Frame -> 
        True, 
FrameTicks -> 
        None, 
FrameLabel -> {"Relative frequency", "Relative amplitude", "", ""}]\)