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$ – Christopher Lamb 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 away 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 away 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$ – Christopher Lamb 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 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.