7
$\begingroup$

Bach's Prelude in C is repetitious in an easily modelable manner: Each of the first 32 bars is structured so that, if given the first 5 notes, you can construct the entire 16 note bar by appending notes 3 - 5, then doubling the resulting 8 notes. So, given C D A D F, we generate CDADFADF CDADFADF. The attached code does the job, but seems ugly by having what appear to be excessive (and repetitive!) references to what I've called bwv846 (the notes from which the entire melody is generated).

bwv846 =
  {{"C", "E", "G", "C5", "E5"}, {"C", "D", "A", "D5", "F5"},
   {"B3", "D", "G", "D5", "F5"}, {"C", "E", "G", "C5", "E5"},
   {"C", "E", "A", "E5", "A5"}, {"C", "D", "F♯", "A", "D5"},
   {"B3", "D", "G", "D5", "G5"}, {"B3", "C", "E", "G", "C5"},
   {"A3", "C", "E", "G", "C5"}, {"D3", "A3", "D", "F♯", "C5"}, 
   {"G3", "B3", "D", "G", "B"}, {"G3", "B♭3", "E", "G", "C♯5"},
   {"F3", "A3", "D", "A", "D5"}, {"F3", "A♭3", "D", "F", "B"},
   {"E3", "G3", "C", "G", "C5"}, {"E3", "F3", "A3", "C", "F"},
   {"D3", "F3", "A3", "C", "F"}, {"G1", "D3", "G3", "B3", "F"},
   {"C3", "E3", "G3", "C", "E"}, {"C3", "G3", "B♭3", "C", "E"},
   {"F2", "F3", "A3", "C", "E"}, {"F♯2", "C3", "A3", "C", "E♭"},
   {"A♭2", "F3", "B3", "C", "D"}, {"G2", "F3", "G3", "B3", "D"},
   {"G2", "E3", "G3", "C", "E"}, {"G2", "D3", "G3", "C", "F"},
   {"G2", "D3", "G3", "B3", "F"}, {"G2", "E♭3", "A3", "C", "F♯"}, 
   {"G2", "E3", "G3", "C", "G"}, {"G2", "D3", "G3", "C", "F"},
   {"G2", "D3", "G3", "B3", "F"}, {"C1", "C2", "G3", "B♭3", "E"}}; 

finale =
  {"C1", "C2", "F3", "A3", "C", "F", "C", "A3", "C", "A3", "F3", "A3",
   "F3", "D3", "C1", "B1", "G", "B", "D5", "F5", "D5", "B", "D5", 
   "G","B", "D", "F", "E", "D", {"C1", "C2", "E", "G", "C5"}};

tblBWV846 = 
  Flatten[
    Table[
      Join[
        Table[
          Join[bwv846[[i]], Take[bwv846[[i]], -3]], {i, Length[bwv846]}][[j]],
        Table[
          Join[bwv846[[i]], Take[bwv846[[i]], -3]], {i, Length[bwv846]}][[j]]], 
      {j, Length[bwv846]}]];   

EmitSound[
 Sound[    
  SoundNote[#, 0.25, "Piano"] & /@  Join[tblBWV846, finale]   ]]

So this is a question involving elementary list manipulation; it is not a music question.

$\endgroup$
  • 1
    $\begingroup$ Try this: construct16Bar = Flatten[{#, #}] &@{#, Take[#, -3]} &; tblBWV846 = (construct16Bar /@ bwv846) // Flatten; $\endgroup$ – Anjan Kumar Sep 19 '17 at 3:49
  • $\begingroup$ Thanks, @Anjan Kumar. Exactly what I was looking for. $\endgroup$ – Rabbit Sep 19 '17 at 13:03
  • $\begingroup$ Very nice. Is there a function to stop emitting sound? $\endgroup$ – QuantumDot Sep 19 '17 at 17:04
  • $\begingroup$ @Quantum, remove the EmitSound[] part so that you get a player that can be paused. $\endgroup$ – J. M. is slightly pensive Sep 20 '17 at 2:28
4
$\begingroup$

Thee is no reason not to do it with Table; the computation can be reduced to

tblBWV846 =
  Flatten[
    Table[
      ConstantArray[{bwv846[[i]], Take[bwv846[[i]], -3]}, 2], 
      {i, Length[bwv846]}]];

Beautiful music. Thanks for posting this question.

Update

The code golf version

mainBWV846 = (ConstantArray[{#, #[[-3 ;;]]}, 2] & /@ bwv846) // Flatten;
$\endgroup$
  • 1
    $\begingroup$ A slightly compact version: tblBWV846 = Flatten[Table[PadRight[{}, 16, Join[l, Drop[l, 2]]], {l, bwv846}]];. Personally, I like the violin: EmitSound[Sound[SoundNote[#, 0.25, "Violin"] & /@ Join[tblBWV846, finale]]] $\endgroup$ – J. M. is slightly pensive Sep 19 '17 at 16:58
  • 1
    $\begingroup$ @J.M. I tried piano, violin, harpsichord and organ. The organ version sounds best to me. $\endgroup$ – m_goldberg Sep 20 '17 at 2:20
  • 2
    $\begingroup$ To make it sound more human, you might for example define randomRubato[] := RandomVariate[RayleighDistribution[0.025]], and use Sound[SoundNote[#, 0.25 + randomRubato[], "Piano"] & /@ Join[tblBWV846, finale]] instead. $\endgroup$ – ulvi Sep 21 '17 at 1:57
  • $\begingroup$ Admittedly at risk of violating the "Thanks/Me too" taboo, I've gotta thank you for the education. I value it (from J.M., bill s, Anjan Kumar, m_goldberg, and ulvi). $\endgroup$ – Rabbit Sep 23 '17 at 3:42
5
$\begingroup$

This is a perfect application of a user-defined function:

chorale[x_] := {x, x[[3 ;; 5]], x, x[[3 ;; 5]]} // Flatten;

Then you can form the complete piece by mapping the function over the data bwv846:

chorale[#] & /@ bwv846

though you'll have to add the finale on separately.

$\endgroup$

Your Answer

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.

Not the answer you're looking for? Browse other questions tagged or ask your own question.