Endlessly Rising Canon in R

 

A few months ago it came up that someone was able to get audio to play in my preferred programming language, R.  Even better, the piece they orchestrated was the highly litigated “Birthday Song” that was even more recently freed from copyright purgatory.  I quickly realized that this was an excellent opportunity to finally get the precision I wanted from the experimental Bach Canon that I had previously composed.  So that’s what I did!

Old School

You can listen to my original version to while reading my original verbose explanation below:

The Endlessly Rising Canon (Canon a 2, per tonos; Bach’s Musical Offering) was made known to me by Douglas Hofstadter’s Pulitzer-winning book Godol, Escher, Bach: an Eternal Golden Braid. The canon consists of an eight measure phrase beginning in C minor. “What makes this canon different from any other is that when it concludes-or, rather, seems to conclude-it is no longer in the key of C minor, but now is in D minor… And it is so constructed that this ‘ending’ ties smoothly onto the beginning again… After six repetitions of the canon it returns to the key of C minor, but now one octave higher.”

[…]

Anyone who has played with a record player knows that as the speed of an audio track increases, so does it’s pitch. A sound played twice as fast has the same pitch as before, but one octave higher. I exploit this audio-timescale/pitch-modification connection to play the canon in 16 different octaves.

I record one iteration of the canon and speed it up digitally by a factor of 2^1/6 or 1.1225 (or 12.25% faster) to get the next iteration of the canon… just as recording a C4 tone and increasing its tempo by a factor of 1.1225 will result in a D4 tone. Repeating this process six times results in the tempo doubling; i.e. a power rule of exponents. With six iterations recorded I am able to paste them together as one audio file and digitally double the tempo to get the next six iterations that are one octave higher. This process was repeated 16 times resulting in the canon being played in 16 different octaves (C4 to C19), with the tempo doubling 16 times (60 bpm to 3932160 bpm ( or 2^16 = 65536 beats per second (bps) ) ). To make the speed/tempo increase smooth throughout the canon, each measure is 2^(1/6*1/8) or 1.01455 times (1.455 %) faster than the previous measure.

New School

I’m going to walk through the code that I used to create this piece in R. The major contributions here are that I had to figure out how to:

  1. create polyphony from two sine waves

  2. speed up the a wave’s tone while increasing its pitch

  3. create mathematically precise accelerando

Warning: You’ll need to be able to at least copy/paste code into R to listen to this piece. Also, the audio package doesn’t have native Linux support. If someone gets it working key me know.

I worked off of the original StackExchange piece, but it had a very new school style of R coding utilizing the magrittr and dplyr packages. My brain works much more clearly in vanilla R so I converted many of the pieces back to something more familiar to me. For that reason, the code is a bit of a hodge-podge of naming conventions. Also, I code at work all day, so I’m letting my hair down on this one.


First, I loaded the audio library and then I hard-coded the notes and their corresponding numbers that were later used to create the actual sine waves.

library("audio")

notes <- c(G2 = -14, Ab2 = -13, A2 = -12, Bb2 = -11, B2 = -10,
           C3 = -9, Db3 = -8, D3 = -7, Eb3 = -6, E3 = -5,
           F3 = -4, Fs3 = -3, Gb3 = -3, G3 = -2, Ab3 = -1,
           A3 = 0, Bb3 = 1, B3 = 2, C = 3,
           Db = 4, D = 5, Eb = 6, E = 7, F = 8,
           Fs = 9, Gb = 9, G = 10, Ab = 11)

notes.num <- notes + 48

Next I used the almost the exact same make_sine function, except that I removed the last sample from the wave vector. I did this so I would get the desired number of samples and not the desired number plus 1.

make_sine <- function(freq, duration, tempo, sample_rate) {
  wave <- sin(seq(0, duration / tempo * 60, 1 / sample_rate) *
                freq * 2 * pi)
  wave <- wave[-length(wave)]
  fade <- seq(0, 1, 50 / sample_rate)
  wave * c(fade, rep(1, length(wave) - 2 * length(fade)), rev(fade))
}

Next I used this as a piece of a larger wave making function. It’s mostly a rewrite of the StackExchange code, but with a pitch.adjust parameter added in to make the transpositions required for this easier to implement.

make_wave <- function(pitch, duration,
                      tempo = 15,
                      sample_rate = 48000,
                      pitch.adjust = 0){
  canon <- data.frame(pitch = pitch,
                      duration = duration, stringsAsFactors = FALSE)
  # Extract the octave number
  octave <- suppressWarnings(as.numeric(substring(canon$pitch,
                                                  nchar(canon$pitch))))
  octave <- ifelse(is.na(octave), 4, octave)

  note <- notes.num[pitch]
  note <- note + pitch.adjust
  freq <- 2 ^ ((note - 60) / 12) * 440

  # Need to change the names so that cbind works.
  if(length(freq) >= 1){
    names(freq) <- 1:length(freq)
    names(note) <- 1:length(note)
  }
  canon <- cbind(canon, octave = octave,
                 note = note, freq = freq)

  canon_wave <- do.call("c", as.list(mapply(make_sine, canon$freq,
                                            canon$duration,
                                            tempo, sample_rate)))
  # Here we turn the NAs generated by the "rest" beats into silence; i.e. 0
  canon_wave[which(is.na(canon_wave))] <- 0
  canon_wave
}

CanonScore

Next the painstaking work of turning the two voices in the score above into notes and their durations. It should be noted that the duration used here corresponds to the note name; i.e. an eighth note last for 1/8… of a measure. So to get the tempo to match beats per minute (bpm) we have to multiply it by 4. That is, a tempo of 15 is equal to 60bpm.

pitch <- c("C", "D", "Eb", "E", "F", "Fs",
           "G", "Ab", "F", "Db", "C",
           "B3", "rest", "rest", "G",
           "Fs", "F",
           "E", "Eb",
           "D", "Db", "Bb3", "A3",
           "D", "rest", "rest", "G",
           "F", "E")

duration <- c(3 / 8, 1 / 8, 1 / 8, 1 / 8, 1 / 8, 1 / 8,
              1 / 2, 5 / 16, 1 / 16, 1 / 16, 1 / 16,
              1 / 4, 1 / 4, 1 / 4, 1 / 2,
              1 / 2, 1 / 2,
              1 / 2, 1 / 2,
              3 / 8, 1 / 8, 1 / 8, 1 / 8,
              1 / 4, 1 / 4, 1 / 4, 1 / 2,
              1 / 4, 1 / 2)

pitch.bass <- c("E3", "C3", "Eb3", "G3", "C", "Bb3", "A3",
                "Bb3", "E3", "D3", "E3", "F3", "C2", "F3", "G3", "Ab3",
                "Ab3", "G3", "F3", "Eb3", "F3", "Eb3", "D3",
                "C3", "Db3", "D3", "rest", "Eb3", "D3", "C3",
                "B2", "C3", "B2", "C3", "D3", "C3", "Bb2",
                "A2", "G2", "A2", "Bb2", "C3", "A2", "Bb2", "C3",
                "D3", "C4", "Bb3", "A3", "Bb3", "G3", "E3", "A3", "G3",
                "Fs3", "G3", "A3", "Bb3", "Db3", "D3", "rest",
                "rest", "D3", "F3", "E3", "D3",
                  "Db3", "D3", "E3", "F3", "G3", "Bb3", "A3", "G3")

duration.bass <- c(1 / 16, 1 / 16, 1 / 16, 1 / 16, 1 / 2, 1 / 8, 1 / 8,
                   5 / 16, 1 / 16, 1 / 16, 1 / 16,
                    1 / 16, 1 / 16, 1 / 16, 1 / 16, 3 / 8,
                   1 / 8, 1 / 8, 1 / 8, 5 / 16, 1 / 16, 1 / 16, 1 / 16,
                   1 / 8, 1 / 8, 1 / 4, 1 / 8, 1 / 8, 1 / 8, 1 / 8,
                   1 / 8, 1 / 16, 1 / 16, 1 / 16, 1 / 16, 1 / 16, 1 / 16,
                    1 / 16, 1 / 16, 1 / 16, 1 / 16,
                    1 / 16, 1 / 16, 1 / 16, 1 / 16,
                   1 / 8, 1 / 4, 1 / 16, 1 / 16,
                    1 / 8, 1 / 8, 1 / 8, 1 / 16, 1 / 16,
                   1 / 8, 1 / 16, 1 / 16, 1 / 8, 1 / 8, 1 / 4, 1 / 4,
                   1 / 8, 3 / 16, 1 / 16, 1 / 16, 1 / 16,
                    1 / 16, 1 / 16, 1 / 16, 1 / 16,
                    1 / 16, 1 / 16, 1 / 16, 1 / 16)

To make proper use of the accelerando I had to figure out where both voices started a new note so that they wouldn’t get out of sync.

int.cumsum <- intersect(cumsum(duration), cumsum(duration.bass))
cumsum.points <- which(cumsum(duration) %in% int.cumsum)
cumsum.points.start <- c(1, cumsum.points[-length(cumsum.points)] + 1)
cumsum.points.end <- cumsum.points

cumsum.points.bass <- which(cumsum(duration.bass) %in% int.cumsum)
cumsum.points.start.bass <- c(1, cumsum.points.bass[-length(cumsum.points.bass)] + 1)
cumsum.points.end.bass <- cumsum.points.bass

Next I instantiate the variables required to define the fraction by which I have to increase the speed of each chunk of the canon. You’ll notice that if you were to go through all 8 bars of the canon 6 times, the speed would be doubled. This would put you at the next octave which is the desired effect.

duration.increase <- 2 ^ (c(0, int.cumsum) / 8 * 1/6)
duration.accel <- rep(0, length(duration))
duration.accel.bass <- rep(0, length(duration.bass))

Finally we get the code to generate the core of the canon. By core I mean one round through the entire octave. Each chunk is composed in each voice and then the two waves are simply averaged to generate polyphony. I go through chunk by chunk of the accelerando because the different number of notes in each voice creates slight differences in the lengths of generated waves. R throws a warning. Doing them all at once makes them fall out of sync. I tried to think of a way to find a sample rate that would prevent this, but between the two voices, changing tempos, and day job I quit before I found a good solution. It might require a prohibitively large sample rate. The sample rate I ended up going with was chosen to extend the tempo doubling as far as possible. This is discussed in more detail below.

sample_rate <- 30159

core <- c()
for(j in 1:6){
  cat(c("C", "D", "E", "F#", "G#", "A#")[j])
  canon_wave.piece <- rep(list(list()), length(int.cumsum))
  canon_wave.bass.piece <- rep(list(list()), length(int.cumsum))
  canon_wave.both.piece <- rep(list(list()), length(int.cumsum))

  for(i in 1:(length(duration.increase) - 1)){
    ind <- cumsum.points.start[i]:cumsum.points.end[i]
    duration.accel[ind] <- duration[ind] / (duration.increase[i] * (2 ^ ((j - 1) / 6)))
    # Notice the pitch.adjust parameter that progresses throught the different keys.
    canon_wave.piece[[i]] <- make_wave(pitch[ind], duration.accel[ind],
                                       tempo = 15,
                                       sample_rate = sample_rate,
                                       pitch.adjust = 2 * (j - 1))

    ind.bass <- cumsum.points.start.bass[i]:cumsum.points.end.bass[i]
    duration.accel.bass[ind.bass] <-
      duration.bass[ind.bass] / duration.increase[i] / (2 ^ ((j - 1) / 6))

    canon_wave.bass.piece[[i]] <- make_wave(pitch.bass[ind.bass],
                                            duration.accel.bass[ind.bass],
                                            tempo = 15,
                                            sample_rate = sample_rate,
                                            pitch.adjust = 2 * (j - 1))

    # The two voices are average to create polyphony
    canon_wave.both.piece[[i]] <- apply(cbind(canon_wave.piece[[i]],
                                        canon_wave.bass.piece[[i]]),
                                        1, mean, na.rm = T)
  }
  core <- c(core, unlist(canon_wave.both.piece))
}

Finally, we are to the part where we have a single pass through an entire octave. To get to the next iteration of the octave, we simply remove every other sample in the wave. I go through 23 octaves total by virtue of the number of samples from the original core.

endless <- core
for(i in 1:22){
  core <- core[seq(1, length(core), 2)]
  cat(length(core), "\n")
  endless <- c(endless, core)
}

Finally, it plays.

play(endless, rate = sample_rate)

This piece has a special place in my heart and brain. I studied the philosophy of science as an undergrad and it culminated in working through Gödel’s completeness and incompleteness theorems. Between undergrad and grad school I read through Gödel, Escher, Bach (GEB). When I started studying statistical/machine learning and started using the R language, I kept the lessons of GEB in mind… mostly as a way to keep my head out of the clouds. Being able to compose this piece in R while using my music theory brings it all together. I can now die a happy man.