Spiral sound waves

Artisitc visualisation of sound waves on a spiral

My sister-in-law recently purchased a framed print of the sound-wave for the song ‘Fly me to the moon’ by Frank Sinatra - it was the song that she and her husband chose for the first dance at their wedding. I thought this was a really neat idea and a unique piece of ‘art’ to hang on the wall with personal, sentimental meaning.

Of course, it got me thinking if I could create a similar style of graphic using R, and I say similar, because what I thought might actually look better would be to plot the sound wave on a spiral - mimicking the look of an old vinyl long play record.

Spirals are pretty cool, they look great and are interesting mathematically so this post details how I arrived at my solution for creating these types of graphics.

Spirals

My initial thought was that I should generate a spiral and then somehow map the sound-wave to it, but after a few hours of research and plotting numerous traces in R, I realised that this probably wasnt the way to go. Im not saying that it can’t be done like this - Im saying that I wasn’t making any progress by taking this approach so decided to have a rethink.

My next approach was to attempt transforming a linear sound-wave into polar coordinates - and thats when I started getting some traction. After playing around for a while with ggplot2 and coord_polar(), I realised that the task of creating a spiral is much simpler if you can first generate the sound wave in cartesian coordinates (in the correct format) such that when transformed to polar coordinates, a spiral is generated. By allowing ggplot2::coord_polar() to do this, I’m essentially avoiding the hard maths and letting someone else take care of it!

Cartesian coordinates to polar coordinates

The conclusion I came to was that if I can generate the plot on the left (which should be fairly easy), it’s trivial to convert it to the plot on the right (in polar coordinates).

Solution

I start by bringing the sound-wave I want to visualise into R. I am using tuneR::readMP3() which I have done absolutely no research into, but it was the first hit when I searched for importing sound files into R and it seems to work well enough for my needs here.

(I’ll just mention here that I am also the drummer in a punk rock band called Athena Rockets and natuarally here I am using the sound wave from one of our songs deadbeat)

# Import MP3
mp3 <- tuneR::readMP3("deadbeat.mp3")

# View object
mp3
## 
## Wave Object
##  Number of Samples:      7079040
##  Duration (seconds):     160.52
##  Samplingrate (Hertz):   44100
##  Channels (Mono/Stereo): Stereo
##  PCM (integer format):   TRUE
##  Bit (8/16/24/32/64):    16

I’m not sure what I was expecting, but the number of samples is massive (over 7 million) which is clearly going to be a problem when it comes to both plotting and rapidly developing a solution - so for the purposes of this code, I am going to reduce the size of the trace by averaging every 100 values.

In order to do that, I have written a little helper function that computes the average values of a vector for a given window size. The window just moves along the vector, so the last window is unlikely to be the same size as the others - but I’m OK with that for this exercise. Also note that the mp3 is recorded in stereo, so here I am only extracting one channel (left). A cool extension of this would be to visualise both channels simultaneously!

# Group nean helper function
gm <- function(x, n) tapply(x, rep(seq_along(x), each = n, length.out=length(x)), mean)

# Create the 'reduced' trace (average every ~100 values)
mp3_reduced <- gm(mp3@left, 100)

Note how the averaging significantly changes the trace!

tibble(x = c(1:length(mp3@left), 1:length(mp3_reduced)),
       y = c(mp3@left, mp3_reduced),
       f = rep(c("Original", "Reduced"), times=c(length(mp3@left), length(mp3_reduced)))) %>% 
  ggplot(aes(x, y))+
  geom_line()+
  facet_wrap(~f, scales="free_x", ncol=1)

Input parameters

Define input parameters

# Define the input sound wave
data <- mp3_reduced

# Number of rings in spiral
n <- 20

# Size of spiral inner radius in units of the data
r <- 100

# Gradient of the spiral (dy/dx)
m = -0.1

Computed parameters

Values that are computed given the input parameters

# Number of data points
n_data <- length(data)
  
# Points per ring (the number of equally separated points that make up each ring of the spiral)
# This value is computed such that all elements of the input sound wave will be used
ppr <- ceiling((n_data/n)+1)
  
# Total points in visualisation
t_points <- ppr * n 
  
# Difference between total points in n_rings FULL rings and actual data points
delta <- t_points - n_data
  
# Outer radius of spiral
c <- (n * abs(m) * ppr) + r
  
# Max amplitude for signal to not bleed across the spiral rings (with 1% buffer)
dy <- ((m * ppr)/2) * 0.99

Create dataframe to plot

I now create a dataframe that processes the computed parameters. Note that because for a ppr points per ring, the actual number of new data points from data that are plotted on each ring is ppr -1 because the first value must be the same as the last value from the previous ring in order for the spiral to be continuous. So here there is an infill where I pack out the last spiral with delta values (computed above) to make the last spiral ring complete.

df <-
  tibble(x = 1:t_points,
         y = c(data/max(data)*dy, rep(NA, delta))) %>% 
  mutate(g = as.factor(rep(1:n, each = ppr)),
         y2 = y + ((m * x) + c))

Now define the x_chunks and y_chunks that make up each spiral ring. The x_chunks are just a sequence of length ppr repeated n_rings times. The y_chunks are the subset of the data ensuring that the first value of a chunk is the same as the last value of the previous chunk.

# Compute x and y chunks so that in polar coordinates the same x points are repeated
# and the last point in y of chunk 1 is the first point in y of chunk 2 (and so on...)
# Create the x-chunks
x_chunks <- rep(0:(ppr-1), times = n)
df$x_chunks <- x_chunks

# Create the y-chunks
step <- ppr - 1
y_chunk_indices <- map(1:n, ~(1:ppr) + (step * (.x-1)))
y_chunks <- map(y_chunk_indices, ~df$y2[.x])
df$y_chunks <- unlist(y_chunks)

Now plot it (both cartesian and polar)

p <- 
  ggplot(df)+
  geom_line(aes(x_chunks, y_chunks, group = g), 
            linejoin="bevel", size=0.01)+
  expand_limits(y=0)

p + (p + coord_polar())
## Warning: Removed 10 rows containing missing values (geom_path).

## Warning: Removed 10 rows containing missing values (geom_path).

Function

I have taken the workings above (with some extra bits) and created a function to repeat the process more easily.

spiral <- function(data, n, r, m=0.2, lwd=0.001, 
                   mult_buffer = 0.99, 
                   add_buffer = 0,
                   infill = NA,
                   centre_text = NULL,
                   bg_col = "white",
                   line_col = "black", 
                   text_col = "black",
                   markup = FALSE){
  
  n_data <- length(data)
  
  # Points per ring (the number of equally separated points that make up each ring of the spiral)
  # This value is computed such that all elements of the input sound wave will be used
  ppr <- ceiling((n_data/n)+1)
  
  # Total points in visualisation
  t_points <- ppr * n 
  
  # Difference between total points in n_rings FULL rings and actual data points
  delta <- t_points - n_data
  
  # Straight line offset (radius of whole spiral from origin of plot)
  c <- (n * abs(m) * ppr) + r
  
  # Max amplitude for signal to not bleed across the spiral rings (with 1% buffer)
  dy <- (((m * ppr)/2) * mult_buffer) + add_buffer
  
  # Create dataframe
  df <-
    tibble(x = 1:t_points,
           y = c(data/max(data)*dy, rep(infill, delta))) %>% 
    mutate(g = as.factor(rep(1:n, each = ppr)),
           y2 = y + ((m * x) + c))
  
  # Compute x and y chunks so that in polar coordinates the same x points are repeated
  # and the last point in y of chunk 1 is the first point in y of chunk 2 (and so on...)
  # This ensures the individual spiral rings line up perfectly 
  # Create the x-chunks
  x_chunks <- rep(0:(ppr-1), times = n)
  df$x_chunks <- x_chunks
  
  # Create the y-chunks
  step <- ppr - 1
  y_chunk_indices <- map(1:n, ~(1:ppr) + (step * (.x-1)))
  y_chunks <- map(y_chunk_indices, ~df$y2[.x])
  df$y_chunks <- unlist(y_chunks)
  
  if(markup){
    return(
      ggplot(df)+
        geom_hline(yintercept = c, col=4, size=1)+
        geom_hline(yintercept = r, col=2, size=1)+
        geom_line(aes(x_chunks, y_chunks, group = g), 
                  linejoin="bevel", size=lwd, col=line_col)+
        annotate(geom = "text", x=0, y=0, label=centre_text, col=text_col)+
        expand_limits(y=0)+
        theme(text = element_text(colour=text_col))+
        coord_polar()+
        labs(x="x", y="y")
    )
  }
  
  ggplot(df)+
    # annotate(geom="rect", xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = c*1.05, fill = "black")+
    # annotate(geom="rect", xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = hole_size*0.9, fill = "purple")+
    # geom_hline(yintercept = c, col=4)+
    # geom_hline(yintercept = r, col=2)+
    geom_line(aes(x_chunks, y_chunks, group = g), 
              linejoin="bevel", size=lwd, col=line_col)+
    annotate(geom = "text", x=0, y=0, label=centre_text, col=text_col)+
    theme_void()+
    expand_limits(y=0)+
    theme(plot.background = element_rect(fill=bg_col),
          text = element_text(colour=text_col))+
    coord_polar()
  }

Plot a few examples with different parameters. As the trace I am plotting is centered on 0, I can use an infill value of 0 to avoid the last few points being NA

a <- spiral(mp3_reduced, n=20, m=-0.1, r=2000, lwd=0.5, infill = 0)

b <- spiral(mp3_reduced, n=10, m=-0.1, r=2000, lwd=0.5, infill = 0,
            bg_col = "darkgreen", line_col = "white")

c <- spiral(mp3_reduced, n=5, m=-0.1, r=2000, lwd=0.5, infill = 0,
            bg_col = "midnightblue", line_col = "gold")

d <- spiral(mp3_reduced, n=2, m=-0.1, r=2000, lwd=0.5, infill = 0,
            bg_col = "darkred", line_col = "white")

(a + b)/(c + d)

Plot a version with the markup included (helpful for debugging or trying to understand what is going on!)

spiral(mp3_reduced, n=20, m=-0.1, r=2000, lwd=0.01, mult_buffer=1, markup = T)
## Warning: Removed 10 rows containing missing values (geom_path).

As mentioned in the ggplot2::coord_polar() documentation, polar coordinates should be used with EXTREME caution as polar coordinates has major perceptual problems. And it’s clear that the polar versions of these sonud-waves do look oddly different from the cartesian versions - so much so that I often had to check I was plotting the correct thing. Here, I am only trying to create artistic visualisations - so the perceptual problems with polar coordinates are irrelevant.

Avatar
Chris Holmes
Senior Data Scientist

PhD physicist making his way in the world of data science!

comments powered by Disqus