Message Boards Message Boards

GROUPS:

Canon in two voices

Posted 3 years ago
2968 Views
|
2 Replies
|
8 Total Likes
|

Have a melody (in this case by Joseph Jacobsen, related text by Hans-Herrmann Bittger)

Clear[line]
line[t_?NumericQ, x_String] := {
   {(* Takt 1 *)
    SoundNote[None, 3 t/4, x],
    SoundNote["CFlat4", t/8, x], SoundNote["CFlat4", t/8, x]},
   {(* Takt 2 *)
    SoundNote["E4", t/4, x], SoundNote["E4", t/8, x], 
    SoundNote["FSharp4", t/8, x], SoundNote["G4", t/4, x], 
    SoundNote["FSharp4", t/8, x], SoundNote["G4", t/8, x]},
   {(* Takt 3 *)
    SoundNote["E4", 3 t/4, x], SoundNote["E4", t/8, x], 
    SoundNote["E4", t/8, x]},
   {(* Takt 4 *)
    SoundNote["A4", t/4, x], SoundNote["A4", t/8, x], 
    SoundNote["CFlat5", t/8, x], SoundNote["C5", t/4, x], 
    SoundNote["CFlat5", t/8, x], SoundNote["A4", t/8, x]},
   {(* Takt 5 *)
    SoundNote["CFlat5", 3 t/4, x], SoundNote["CFlat5", t/8, x], 
    SoundNote["A4", t/8, x]},
   {(* Takt 6 *)
    SoundNote["G4", t/4, x], SoundNote["G4", t/8, x], 
    SoundNote["A4", t/8, x], SoundNote["CFlat5", t/4, x], 
    SoundNote["C5", t/8, x], SoundNote["CFlat5", t/8, x]},
   {(* Takt 7 *)
    SoundNote["A4", t/8, x], SoundNote["C5", t/8, x], 
    SoundNote["CFlat5", t/8, x], SoundNote["A4", t/8, x], 
    SoundNote["G4", t/4, x], SoundNote["G4", t/4, x]},
   {(* Takt 8 *)
    SoundNote["FSharp4", t/4, x], SoundNote["FSharp4", t/8, x], 
    SoundNote["G4", t/8, x], SoundNote["A4", t/4, x], 
    SoundNote["G4", t/8, x], SoundNote["FSharp4", t/8, x]},
   {(* Takt 9 *)
    SoundNote["G4", t/8, x], SoundNote["FSharp4", t/8, x], 
    SoundNote["E4", t/2, x], SoundNote[None, t/4, x]}
   };

Sound[line[E, "Bandoneon"]]

enter image description here

make it into a canon a two voices

     (* Zweistimmig *)
     Clear[noteQ, acC, equalBar, intersequenceQ, stammer, \
     intersequenceBar, doIntersequences, canonA2]
     noteQ[x_] := Head[x] == SoundNote
     acC[x1_SoundNote, x2_SoundNote] := 
      SoundNote[{x1[[1]], x2[[1]]}, Sequence @@ Rest[x1]]
     equalBar[v1_List, v2_List] := Inner[acC, v1, v2, List];
     intersequenceQ[t1_List, t2_List] := 
      Block[{o1 = 1, o2 = 1, a1 = Accumulate[t1], a2 = Accumulate[t2], r},
       (* Wird das grössere Intervall einerseits durch mehrere kleinere \
     Intervalle andererseits aufgefüllt? *)
       r = Sign[a1[[1]] - a2[[1]]];
       While[o1 <= Length[t1] && o2 <= Length[t2],
        If[a1[[o1]] == a2[[o2]],
         o1++;
         o2++;
         r = 0, (* else *)
         If[a1[[o1]] < a2[[o2]],
          If[r <= 0, r--, Return[False]];
          o1++, (* else *)
          If[r >= 0, r++, Return[False]];
          o2++
          ]
         ]
        ];
       r == 0
       ]
     stammer[v1_List, v2_List] :=
      Block[{long, short, o, rS = {}},
        (* v1 oder v2 bestehen aus genau einer Note *)
        (* Print["stammer v1: ",v1,"|v2: ",v2]; *)
        If[Length[v1] <= Length[v2],
         short = v1[[1]];
         long = v2, (* else *)
         short = v2[[1]];
         long = v1
         ];
        For[o = 1, o <= Length[long], o++,
         rS = Join[
           rS, {SoundNote[{short[[1]], long[[o, 1]]}, long[[o, 2]], 
             long[[o, 3]]]}]
         ];
        rS
        ] /; Length[v1] == 1 || Length[v2] == 1
     intersequenceBar[v1_List, v2_List] := 
      Block[{a1 = Accumulate[v1[[All, 2]]], a2 = Accumulate[v2[[All, 2]]], 
        o1 = 1, o2 = 1, s1 = 1, s2 = 1, rS = {}},
       (* intersequenceQ was True *)
       While[o1 <= Length[a1] && o2 <= Length[a2],
        If[a1[[o1]] == a2[[o2]],
         rS = Join[rS, stammer[v1[[s1 ;; o1]], v2[[s2 ;; o2]]]];
         o1++;
         o2++;
         s1 = o1;
         s2 = o2;
         r = 0, (* else *)
         If[a1[[o1]] < a2[[o2]],
          o1++, (* else *)
          o2++
          ]
         ]
        ];
       rS
       ]
     doIntersequences[v1_List, v2_List] := 
      Block[{w1 = v1, w2 = v2, o1, o2, a1, a2, frac},
       (* v1 und v2 sind jeweils ein ganzer Takt *)
       Label[oneMoreTime];
       o1 = 1; o2 = 1;
       a1 = Accumulate[w1[[All, 2]]];
       a2 = Accumulate[w2[[All, 2]]];
       r = Sign[a1[[1]] - a2[[1]]];
       While[o1 <= Length[a1] && o2 <= Length[a2],
        If[a1[[o1]] == a2[[o2]],
         o1++;
         o2++;
         r = 0, (* else *)
         If[a1[[o1]] < a2[[o2]],
          If[r <= 0,
           r--, (* else: 
           die aktuelle Note in w1 nach Massgabe von w2 zerlegen *)
           frac = w2[[o2 - 1, 2]];
           w1 = Join[w1[[1 ;; o1 - 1]], {ReplacePart[w1[[o1]], 2 -> frac],
              ReplacePart[w1[[o1]], 2 -> w1[[o1, 2]] - frac]}, 
             w1[[o1 + 1 ;;]]];
           Goto[oneMoreTime]
           ];
          o1++, (* else *)
          If[r >= 0,
           r++, (* else: 
           die aktuelle Note in w2 nach Massgabe von w1 zerlegen *)
           frac = w1[[o1 - 1, 2]];
           w2 = Join[w2[[1 ;; o2 - 1]], {ReplacePart[w2[[o2]], 2 -> frac],
              ReplacePart[w2[[o2]], 2 -> w2[[o2, 2]] - frac]}, 
             w2[[o2 + 1 ;;]]];
           Goto[oneMoreTime]
           ];
          o2++
          ]
         ]
        ];
       {w1, w2}
       ]
     canonA2[l_Symbol (* the notes *),
       off_Integer?Positive (* the offset *),
       x_String (* instrument *),
       s_?NumericQ (* second length *), 
       takt_Integer: 1 (* takt *)] := 
      Module[{v1 = Join[l[1, x], l[1, x]], 
         v2 = Take[
           Join[ConstantArray[{SoundNote[None, takt, x]}, {off - 1}], 
            l[1, x], l[1, x]], 2 Length[l[1, x]]], rS = {}, t1, t2},
        (* processing into accords *)
        For[o = 1, o <= 2 Length[l[s, x]], o++,
         t1 = v1[[o]][[All, 2]];
         t2 = v2[[o]][[All, 2]];
         If[Total[t1] != takt || Total[t2] != takt,
          Print["Bar ", o, " length failure."];
          Return[$Failed]
          ];
         If[t1 == t2,
          rS = Join[rS, equalBar[v1[[o]], v2[[o]]]],(* else *)
          If[intersequenceQ[t1, t2],
           rS = Join[rS, intersequenceBar[v1[[o]], v2[[o]]]], (* else *)
           rS = 
            Join[rS, intersequenceBar[doIntersequences[v1[[o]], v2[[o]]]]]
           ]
          ]
         ];
        Sound[rS /. SoundNote[a_, b__, c___] -> SoundNote[a, s b, c]]
        ] /; And @@ (VectorQ[#, noteQ] & /@ l[1, x]) && 
        off <= Length[l[1, x]] && 
        And @@ (AtomQ /@ (Flatten[l[1, x]][[All, 1]]))

canonA2[line, 5, "Bandoneon", E, 1]

enter image description here

One more parameter would be an offset in the pitch. It stammers because SoundNote[] has no substructure if playing a chord , i.e. each note within a chord has to have the same length: if one had

SoundNote[{{"A4"},{"C5","C5","C5"},{"E5","E5"}},{{1},{1/2,1/4,1/4},{1/2,1/2}},"Bandoneon"]

it wouldn't stammer. If one even had

SoundNote[{{"A4"},{"C5","C5","C5"},{"E5","E5"}},{{1},{1/2,1/4,1/4},{1/2,1/2}},{"Bandoneon", "Violin", "Trumpet"}]

the voices could have different instruments.

Experimenting with $y$ in canonA2[line, y, "Bandoneon", E, 1] one hears that $y=5$ is the right thing, as musicians say and play.

2 Replies

I won't pretend to understand what you did, but this is really neat.

canonA2[] just starts the second voice in the same pitch in the off-th bar of the first voice, taking into account the chord design of SoundNote[].

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract