World's simplest R music system. Part 2 - linear ADSR note shaping

Introduction

Using a raw sine curve as a note will lead to clipping artefacts as the note immediately starts with maximum amplitude and terminates abruptly.

To make the note sound anything like an actual note from an instrument the profile of the note must be shaped to emulate the actual characteristics of a note produced by an actual physical object e.g. the note will ramp up to its playing volume, and then ramp down again.

So by shaping the profile of the raw note (raw sine curve) we can make something that sounds more plausibly like an instrument.

Create naive note

If we create a note of the correct frequency, but with a constant amplitude, then the note will sound harsh.

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Create a note
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
create_note <- function(freq, duration) {
  t <- seq(duration * 44100)
  samples <- sin((t) * 2*pi/ (44100/freq))
  samples
}


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Play a note
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
play_note <- function(samples) {
  audio::play(samples, rate = 44100)
}

note <- create_note(440, 1)

play_note(note)

Shape of a naive note

Looking at the profile of the note we are playing, this immediately starts at the maximum volume i.e. amplitude = 1

plot(note[1:300], type = 'l')

Attack Decay Sustain Release (linear)

Instead of a note staying at the same loudness/amplitude for its duration, we instead shape the note using an envelope.

A common way of shaping the profile of a note is via ADSR - Attack, Decay, Sustain and Release.

Note this code is only creating a piecewise-linear profile. Better sounding envelopes are possible using exponentials.

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Create an ADSR profile of the given length - using only linear segments
#' 
#' @param N length of profile (integer)
#' @param a,d,r fractions of the profile devoted to attack, decay and release
#'        respectively
#' @param s the level of sustain in range [0,1].  The duration of the sustain
#'        will be the remaining fraction after attack, decay and release
#'        are accounted for
#'
#' @return numeric vector in range [0,1] of length N which defines a 
#'         volumn envelope for the note.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
create_adsr_profile <- function(N, a, d, s, r) {
   
  dur <- 1 - a - d - r
  stopifnot(dur >= 0)
  
  profile <- c(
    seq(0, 1, length.out = a * N),
    seq(1, s, length.out = d * N),
    rep(s, length.out = dur * N),
    seq(s, 0, length.out = r * N)
  )
  
  # Ensure we have the right number of elements in case of weird rounding
  length(profile) <- N
  profile[is.na(profile)] <- 0
  
  profile
}


profile <- create_adsr_profile(500, 0.25, 0.25, 0.8, 0.25)
plot(profile, type = 'l')

Compare the sounds of a raw note, and a note profiled with ADSR

note1 <- create_note(440, 0.5)
plot(note1, type = 'l')

profile <- create_adsr_profile(length(note1), 0.1, 0.25, 0.2, 0.6)
note2 <- note1 * profile
plot(note2, type = 'l')

play_note(note1)
play_note(note2)

World’s simplest R mustic system - with linear ADSR profile shaping

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Octaves/Notes/Frequencies in an equal tempered scale
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ets <- tibble(
  freq   = 440 * (2 ^ ((-57:50)/12)),
  note   = rep(c('C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B'), 9),
  octave = rep(0:8, each = 12),
  mnote  = ifelse(nchar(note) == 1, paste(note, octave, sep = "-"), paste(note, octave, sep = ""))
)

head(ets)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Note-to-Freq lookup
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
freq <- setNames(ets$freq, ets$mnote)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Function: Play a note of the given frequency for the given duration
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
play_note <- function(freq, duration) {
  t <- seq(duration * 44100)
  samples <- sin((t) * 2*pi/ (44100/freq))
  
  profile <- create_adsr_profile(length(samples), 0.1, 0.25, 0.2, 0.6)
  samples <- samples * profile

  audio::play(samples, rate = 44100)
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Mary had a little lamb.
# Format is "[Note]-[Octave]"
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
mhall <- c(
  'A-4', 'G-4', 'F-4', 'G-4',  'A-4',  'A-4',  'A-4',
  'G-4', 'G-4', 'G-4', 'A-4', 'C-5', 'C-5',
  'A-4', 'G-4', 'F-4', 'G-4', 'A-4', 'A-4', 'A-4',
  'A-4', 'G-4', 'G-4', 'A-4', 'G-4', 'F-4'
)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Play it
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
for (note in mhall) {
  play_note(freq[[note]], 0.4)
  Sys.sleep(0.4)
}

Live capture of “Mary had a little lamb” - with ADSR note shaping

This will sound as if someone is playing this on a toy piano or similar low quality instrument. But at least it doesn’t sound too harsh.

Live capture of “Mary had a little lamb” - raw note (unmodified sine curve)

This sounds harsh and clipped. Not as pleasant as the notes shaped with ADSR.