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", "B", 
   "G","B", "D", "F", "E", "D", {"C1", "C2", "E", "G", "C5"}};

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

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

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

  • 1
    $\begingroup$ Try this: construct16Bar = Flatten[{#, #}] &@{#, Take[#, -3]} &; tblBWV846 = (construct16Bar /@ bwv846) // Flatten; $\endgroup$ Sep 19 '17 at 3:49
  • $\begingroup$ Thanks, @Anjan Kumar. Exactly what I was looking for. $\endgroup$ 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.'s torpor
    Sep 20 '17 at 2:28
  • $\begingroup$ @Christopher Lamb Nice idea +1. I know this piece of music very well, and that is why I stumbled over a missing tone in your list. I fact you must enter a "B" in position 24 (between "D5" and "G") of finale. Also I was slightly surprised about the hard final accord, maybe you can reduce speed and volume towards the end. So, despite your announcement it was partly a music question ;-) $\endgroup$ May 31 '20 at 10:02

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

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

Beautiful music. Thanks for posting this question.


The code golf version

mainBWV846 = (ConstantArray[{#, #[[-3 ;;]]}, 2] & /@ bwv846) // Flatten;
  • 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.'s torpor
    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$ Sep 23 '17 at 3:42

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.


Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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