Create activity plot for speech and non-speech by two speakers

Viewed 56

I have speech data for two speakers indiating the start and end times when they speak as well as the silences in-between, grouped by minutes:

df <- structure(list(speaker = c(NA, "A", NA, NA, "B", NA, "A", NA, NA, "B", "A"), 
                     start = c(0, 20000, 35000, 60000, 65000, 80000,1e+05, 110000, 120000, 140000, 180000), 
                     end = c(20000, 35000,60000, 65000, 80000, 1e+05, 110000, 120000, 140000, 180000, 195000), 
                     minute = c(0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 3L)), 
                row.names = c(NA,-11L), class = "data.frame")

I'd like to visualize the speakers' speech and non-speech activity in a graphic like this one, where the speakers are assigned colors and their (non-)speech times are depicted in rows each representing a minute:

enter image description here

How can this graph in this or similar form be programmed? I'm open to any solution, be it base R or ggplot2.

EDIT:

One should perhaps start by relating all start and endtimes to the same sequence from 0 to 60000:

library(dplyr)
df %>% 
  group_by(minute) %>%
  mutate(start = start - 60000*minute,
         end = end - 60000*minute)
# A tibble: 11 x 4
# Groups:   minute [4]
   speaker start   end minute
   <chr>   <dbl> <dbl>  <int>
 1 NA          0 20000      0
 2 A       20000 35000      0
 3 NA      35000 60000      0
 4 NA          0  5000      1
 5 B        5000 20000      1
 6 NA      20000 40000      1
 7 A       40000 50000      1
 8 NA      50000 60000      1
 9 NA          0 20000      2
10 B       20000 60000      2
11 A           0 15000      3
1 Answers

Here's an approach where I convert the speaker identity to a number and use that to vertically offset it from the minute.

library(ggplot2)
ggplot(df, aes(x = start, xend = end, 
               y = minute + scale(as.numeric(as.factor(speaker)))/10,
               yend = minute + scale(as.numeric(as.factor(speaker)))/10,
               color = speaker)) +
  geom_segment(size = 4) +
  scale_y_reverse(breaks = 0:10, labels = paste0(0:10, "min"), name = NULL)

enter image description here

EDIT -- based on suggestion to realign the timing by minute, and to include NA:

library(tidyverse)
df %>%
  replace_na(list(speaker = "NA")) %>%
  mutate(start = start - 60000*minute,
         end = end - 60000*minute,) %>%
  ggplot(aes(x = start, xend = end, 
               y = minute + scale(as.numeric(as.factor(speaker)))/10,
               yend = minute + scale(as.numeric(as.factor(speaker)))/10,
               color = speaker)) +
  geom_segment(size = 4) +
  scale_y_reverse(breaks = 0:10, labels = paste0(0:10, "min"), name = NULL)

enter image description here

Related