Sound Examples
for Tuning Experiments

Erich Neuwirth

University of Vienna

The notebook sets ups a few definitions at the beginning.
    To use it, got to the end and run the examples.
    The theory can be found, e.g., in
    Erich Neuwirth
    Musical Temperaments
    Springer Verlag 1997
    The code is used in two papers (with the same title):
    E. Neuwirth: The Mathematics of Tuning Musical Instruments - a Simple Toolkit for Experiments
    in
    C. Bruter (ed): Mathematics and Art, Springer Verlag 2002
    and in
    G. Assayag et al (ed): Mathematics and Music, Springer Verlag 2002

Technical Prerequsites

PitchConst[f_] /; f ≤ 100 := 1.03
PitchConst[f_] /; f ≥ 1000 := 
      1.5
PitchConst[f_] /; (f > 100) && (f < 1000) := 
      N[1.03 + 0.47*(f - 100)/900]
PitchAmpCorr[f_] := Sqrt[(PitchConst[f])^2 - 1]

PlayScale[FreqList_, Duration_] := 
      Module[{ConstList, AmpList}, ConstList = Map[PitchConst, FreqList]; 
        AmpList = Map[PitchAmpCorr, FreqList]; 
        Play[Min[1, Abs[20*(t - Duration*Floor[t/Duration])], 
              Abs[20*(t - Duration*(1 + Floor[t/Duration]))]]*
            AmpList[[1 + Floor[t/Duration]]]*
            Sin[2*Pi*t*
                  FreqList[[1 + Floor[t/Duration]]]]/(ConstList[[1 + 
                        Floor[t/Duration]]] - 
                  Cos[2*Pi*t*FreqList[[1 + Floor[t/Duration]]]]), {t, 
            0, Duration*Length[FreqList] - 0.001}, SampleRate -> 22050, 
          Compiled -> False]]

PlayChord[FreqList_, Duration_] := 
      Module[{ConstList, AmpList}, ConstList = Map[PitchConst, FreqList]; 
        AmpList = Map[PitchAmpCorr, FreqList]; 
        Play[Min[1, 20*t, 20*(Duration - t)]*
            Sum[AmpList[[i]]*(Sin[
                      2*Pi*t*FreqList[[i]]]/(ConstList[[i]] - 
                        Cos[2*Pi*t*FreqList[[i]]])), {i, 1, 
                Length[FreqList]}], {t, 0, Duration - 0.001}, 
          SampleRate -> 22050, Compiled -> False]]

PlayStereoScale[FreqListLeft_, FreqListRight_, Duration_] := 
      Module[{ConstListLeft, AmpListLeft, ConstListRight, AmpListRight}, 
        ConstListLeft = Map[PitchConst, FreqListLeft]; 
        AmpListLeft = Map[PitchAmpCorr, FreqListLeft]; 
        ConstListRight = Map[PitchConst, FreqListRight]; 
        AmpListRight = Map[PitchAmpCorr, FreqListRight]; 
        Play[{Min[1, Abs[20*(t - Duration*Floor[t/Duration])], 
                Abs[20*(t - Duration*(1 + Floor[t/Duration]))]]*
              AmpListLeft[[1 + Floor[t/Duration]]]*
              Sin[2*Pi*t*
                    FreqListLeft[[1 + 
                          Floor[t/Duration]]]]/(ConstListLeft[[1 + 
                          Floor[t/Duration]]] - 
                    Cos[2*Pi*t*FreqListLeft[[1 + Floor[t/Duration]]]]), 
            Min[1, Abs[20*(t - Duration*Floor[t/Duration])], 
                Abs[20*(t - Duration*(1 + Floor[t/Duration]))]]*
              AmpListRight[[1 + Floor[t/Duration]]]*
              Sin[2*Pi*t*
                    FreqListRight[[1 + 
                          Floor[t/Duration]]]]/(ConstListRight[[1 + 
                          Floor[t/Duration]]] - 
                    Cos[2*Pi*t*
                        FreqListRight[[1 + Floor[t/Duration]]]])}, {t, 
            0, Duration*Length[FreqListLeft] - 0.001}, SampleRate -> 22050, 
          Compiled -> False]]

Musical Prerequisites

DiatonicTriad[Scale_, BaseTone_] := 
      List[Scale[[BaseTone]],  
        If[BaseTone  +  2  >  8,  2*Scale[[BaseTone - 5]], 
          Scale[[BaseTone + 2]]], 
        If[BaseTone  +  4  >  8,  2*Scale[[BaseTone - 3]], 
          Scale[[BaseTone + 4]]]]

ScaleFromFifth[Fifth_] := 
      List[1, Fifth^2/2, Fifth^4/4, 2/Fifth, Fifth, Fifth^3/2, Fifth^5/4, 
        2]

ChromaticScaleFromFifth[Fifth_] := 
      List[1, Fifth^7/16, Fifth^2/2, 4/Fifth^3, Fifth^4/4, 2/Fifth, 
        Fifth^6/8, Fifth, Fifth^8/16, Fifth^3/2, 4/(Fifth^2), Fifth^5/4, 
        2]

PureMajorScale = {1, 9/8, 5/4, 4/3, 3/2, 5/3, 15/8, 
        2}
PythagoreanMajorScale = {1, 9/8, 81/64, 4/3, 
        3/2, (4/3)*(81/64), (3/2)*(81/64), 
        2}
\(MeantoneMajorScale = {1, 5^\((1/2)\)/2, 5/4, 2/\((5^\((1/4)\))\), 
        5^\((1/4)\), \((5^\((1/2)\)/2)\)*5^\((1/4)\), \((5/4)\)*5^\((1/4)\), 
        2}		\)
EqualMajorScale = 2^({0, 2, 4, 5, 7, 9, 11, 12}/12)

SyntonicComma = {1, 81/80}
PythagoreanComma = {1, 3^12/2^19}

Experiments

PlayScale[440*N[Table[2^(i/12), {i, 0, 12}]], 1]

PlayScale[264*PureMajorScale, 1.5]

PlayScale[N[264*EqualMajorScale], 1.5]

PlayStereoScale[264*PureMajorScale, 264*EqualMajorScale, 
      1.5]

PlayScale[264*PythagoreanMajorScale, 1.5]

PlayStereoScale[264*PythagoreanMajorScale, 264*PureMajorScale, 
      1.5]

PlayScale[264*MeantoneMajorScale, 1.5]

PlayScale[264*ChromaticScaleFromFifth[3/2], 1]