和音の考察

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

範囲内で最小値を求める

m = 15;
n = 8;
f[p_, q_] := Abs[p*m - q*n]*(1/m);
\(Plot3D[
      f[p, q], {p, 0, n}, {q, 0, 
        m}, 
AxesLabel -> {"x", "y", "z"}, 
ViewPoint -> {\(-1.373\), \ \(-2.491\), \ 
          1.833}]\)

<< Graphics`Graphics3D`;
\(BarChart3D[
      Table[f[p, q], {q, 1, m}, {p, 1, 
          n}], 
AxesLabel -> {"x", "y", "z"}, 
ViewPoint -> {\(-1.099\), \ \(-1.995\), \ 
          2.502}]\)

最小周波数差など

\(\(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];\)

 (*\(JustIntonationFractionList = {1, 16\/15, 9\/8, 13\/11, 5\/4, 4\/3, 7\/5, 
            3\/2, 8\/5, 5\/3, 16\/9, 15\/8};\)*) \)
JustIntonationFractionList = {1, (16/15), (9/8), (6/5), (5/4), (4/3), 
          (45/32), (3/2), (8/5), (5/3), (16/9), (15/8)};

    
SimpleRatio[ABC_] := 
        Module[{}, 
n = 
            Numerator[
              JustIntonationFractionList[[ABCToNumOfHalfTone[ABC] + 
                    1]]]; 
m = 
            Denominator[
              JustIntonationFractionList[[ABCToNumOfHalfTone[ABC] + 
                    1]]]; 
n + 
            m
];
MinOverToneDiff[ABC_] := 
        Module[{}, 
n = 
            Numerator[
              JustIntonationFractionList[[ABCToNumOfHalfTone[ABC] + 
                    1]]]; 
m = 
            Denominator[
              JustIntonationFractionList[[ABCToNumOfHalfTone[ABC] + 
                    1]]]; 
lis = 
            Flatten[Table[
                f[p, q], {q, 1, m}, {p, 1, n}]]; 
If[
            Length[lis] ≠ 
              1, 
Sort[lis][[2]]  // 
              N, 
0]
];
MaxDenoNume[ABC_] := 
        Module[{}, 
n = 
            Numerator[
              JustIntonationFractionList[[ABCToNumOfHalfTone[ABC] + 
                    1]]]; 
m = 
            Denominator[
              JustIntonationFractionList[[ABCToNumOfHalfTone[ABC] + 
                    1]]]; 
Max[n, 
            m]
];
LCMDenoNume[ABC_] := 
        Module[{}, 
n = 
            Numerator[
              JustIntonationFractionList[[ABCToNumOfHalfTone[ABC] + 
                    1]]]; 
m = 
            Denominator[
              JustIntonationFractionList[[ABCToNumOfHalfTone[ABC] + 
                    1]]]; 
n*
            m
];

グラフ表示

\(\(\(ABCList = {"c", "c#", "d", "d#", "e", "f", "f#", "g", "g#", "a", "a#", "b"};\)\(
\)
    \)\)
\(\(PadSpaceToString[str_] := 
        If[StringLength[str] == 
            1, 
str\  <> \ " ", 
str];\)\)
Print["Note    MinOverToneDist    period of (p,q)    Max"];
Do[
Print[
            PadSpaceToString[ABCList[[i]]], ":    ", 
            PaddedForm[
              MinOverToneDiff[ABCList[[i]]], {12, 
                8}], "        ", "(", PaddedForm[n, 2], ",", 
            PaddedForm[m, 2], ")", "        ", 
            Max[m, n]];
, {i, 1, 
          Length[ABCList]}
];

    
<< Graphics`Graphics`;
criteria[1] = 7;
criteria[2] = 13;
BarChart[
        Table[SimpleRatio[ABCList[[i]]], {i, 1, 
            Length[ABCList]}], 
BarLabels -> 
          ABCList, 
PlotLabel -> "Simple Ratio \
(?)", 
Epilog -> {{Dashing[{0.02, 0.02}], 
              Line[{{0, criteria[1]}, {13, 
                    criteria[1]}}]}, 
{Dashing[{0.02, 
                  0.02}], 
              Line[{{0, criteria[2]}, {13, 
                    criteria[2]}}]}}];

    
criteria[1] = 0.2;
criteria[2] = 0.3333;
BarChart[
        Table[MinOverToneDiff[ABCList[[i]]], {i, 1, 
            Length[ABCList]}], 
BarLabels -> 
          ABCList, 
PlotLabel -> "Minimum Difference\
", 
Epilog -> {{Dashing[{0.02, 0.02}], 
              Line[{{0, criteria[1]}, {13, 
                    criteria[1]}}]}, 
{Dashing[{0.02, 
                  0.02}], 
              Line[{{0, criteria[2]}, {13, 
                    criteria[2]}}]}}];

    
criteria[1] = 4;
criteria[2] = 8;
BarChart[
        Table[MaxDenoNume[ABCList[[i]]], {i, 1, 
            Length[ABCList]}], 
BarLabels -> 
          ABCList, 
PlotLabel -> "max(Numerator, \
Denominator)", 
Epilog -> {{Dashing[{0.02, 0.02}], 
              Line[{{0, criteria[1]}, {13, 
                    criteria[1]}}]}, 
{Dashing[{0.02, 
                  0.02}], 
              Line[{{0, criteria[2]}, {13, 
                    criteria[2]}}]}}];