調 (Key)

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

Define Rotate Function

旋律短音階 (melodious minor scale)

\(PrintNoteInterval[WHToneNoteList_] := 
          Module[{}, 
gnotelis = 
              Table[{{AbsoluteThickness[2], 
                    Line[{{\((i - 1)\) - 1/2, \(-1\)/2}, {\((i - 1)\) + 
                            1/2, \(-1\)/2}, {\((i - 1)\) + 1/2, 
                          1/2}, {\((i - 1)\) - 1/2, 
                          1/2}, {\((i - 1)\) - 1/2, \(-1\)/
                            2}}]}, 
Text[
                    StyleForm[WHToneNoteList[\([1, i]\)], 
                      FontSize -> 14, 
                      FontWeight -> "Bold"], {i - 1, 0}, {0, 0}, {1, 
                      0}]}, {i, 1, 
                  Length[WHToneNoteList[\([2]\)]]}]; 
gintervallis = 
              Table[Text[
                  StyleForm[WHToneNoteList[\([2, i]\)], FontSize -> 14, 
                    FontWeight -> "Bold"], {i - 1 + 1/2, 1}, {0, 
                    0}, {1, 0}], {i, 1, 
                  Length[WHToneNoteList[\([1]\)]]}]; 
Show[
              Graphics[{gnotelis, 
                  gintervallis}], 
PlotRange -> 
                All, 
AspectRatio -> 
                Automatic]
];\)

ApplySharp[Note_]:=Module[{},
  
\(If[
              StringTake[
                  Note, \(-1\)] == "♭", 
StringTake[
                Note, {1, 
                  StringLength[Note] - 
                    1}], 
Note\  <> \ "♯"
]\)
];
ApplyFlat[Note_]:=Module[{},
  
\(If[
                StringTake[
                    Note, \(-1\)] == "♯", 
StringTake[
                  Note, {1, 
                    StringLength[Note] - 
                      1}], 
Note\  <> \ "♭"
]\)
];

ApplySharpInScale[NoteWHToneList_, n_]:=Module[{lis = NoteWHToneList},
  
lis = 
              ReplacePart[lis, 
                ApplySharp[lis[[1, n]] ], {1, 
                  n}]; 
lis = 
              ReplacePart[lis, 
                lis[[2, n - 1]] + 1, {2, 
                  n - 1}]; 
lis = 
              ReplacePart[lis, 
                lis[[2, n]] - 1, {2, n}]; 
lis
];
ApplyFlatInScale[NoteWHToneList_, n_]:=Module[{lis = NoteWHToneList},
  
lis = 
                ReplacePart[lis, 
                  ApplyFlat[lis[[1, n]] ], {1, 
                    n}]; 
lis = 
                ReplacePart[lis, 
                  lis[[2, n - 1]] - 1, {2, 
                    n - 1}]; 
lis = 
                ReplacePart[lis, 
                  lis[[2, n]] + 1, {2, n}]; 
lis
];

\(NextSharpMelodiousMinorScale[NoteWHToneList_] := 
          Module[{}, 
LisInitial = {RotateLeft[
                  NoteWHToneList[\([1]\)], 4], 
                RotateLeft[NoteWHToneList[\([2]\)], 
                  4]}; 
Print["**** Initial After RotateLeft[*,4] ****"]; 
PrintNoteInterval[
              LisInitial]; 

Print["**** Modified Minor Scale ****"]; 
LisModified = 
              LisInitial; 
Print["Key: ", 
              LisModified[\([1, 
                  1]\)]\ , " Melodious Minor"]; 

LisModified = 
              ApplyFlatInScale[LisModified, 
                3]; 

LisModified = 
              ApplySharpInScale[LisModified, 
                6]; 
LisModified = 
              ApplySharpInScale[LisModified, 
                7]; 

PrintNoteInterval[
              LisModified]; 

LisModified];\)

\(NextFlatMelodiousMinorScale[NoteWHToneList_] := 
        Module[{}, 
LisInitial = {RotateRight[
                NoteWHToneList[\([1]\)], 4], 
              RotateRight[NoteWHToneList[\([2]\)], 
                4]}; 
Print["**** Initial After RotateRight[*,4] ****"]; 
PrintNoteInterval[
            LisInitial]; 

Print["**** Modified Minor Scale ****"]; 
LisModified = 
            LisInitial; 
Print["Key: ", 
            LisModified[\([1, 
                1]\)], " Melodious Minor"]; 

LisModified = 
            ApplyFlatInScale[LisModified, 
              3]; 
LisModified = 
            ApplyFlatInScale[LisModified, 
              4]; 

LisModified = 
            ApplySharpInScale[LisModified, 
              7]; 

PrintNoteInterval[
            LisModified]; 

LisModified];\)

Sharp Minor

Initial

WHToneNoteList = {{"A", "B", "C", "D", "E", "F\
♯", "G♯"}, {2, 1, 2, 2, 2, 2, 
            1}};
PrintNoteInterval[WHToneNoteList];

1 times

lis1 = NextSharpMelodiousMinorScale[WHToneNoteList]

2 times

lis2 = NextSharpMelodiousMinorScale[lis1]

3 times

lis3 = NextSharpMelodiousMinorScale[lis2]

4 times

lis4 = NextSharpMelodiousMinorScale[lis3]

5 times

lis5 = NextSharpMelodiousMinorScale[lis4]

6 times

lis6 = NextSharpMelodiousMinorScale[lis5]

7 times

lis7 = NextSharpMelodiousMinorScale[lis6]

Flat Minor

Initial

WHToneNoteList = {{"A", "B", "C", "D", "E", "F\
♯", "G♯"}, {2, 1, 2, 2, 2, 2, 
            1}};
PrintNoteInterval[WHToneNoteList];

1 times

lis1 = NextFlatMelodiousMinorScale[WHToneNoteList]

2 times

lis2 = NextFlatMelodiousMinorScale[lis1]

3 times

lis3 = NextFlatMelodiousMinorScale[lis2]

4 times

lis4 = NextFlatMelodiousMinorScale[lis3]

5 times

lis5 = NextFlatMelodiousMinorScale[lis4]

6 times

lis6 = NextFlatMelodiousMinorScale[lis5]

7 times

lis7 = NextFlatMelodiousMinorScale[lis6]