R ggplot: facet_grid with different geom_rects for each facet trouble

Question

I have a time series dataset of accelerometer data on which I've run some peak detections to identify different phases of the gait. I am using ggplot to plot the left and right leg data as two facets in a facet_grid, and now I want to overlay geom_rects to show the different phases of gait for each leg. I can add the rect layers ok, but I cannot figure out how to keep the left geom_rects to the left leg facet and the right geom_rects to the right facet. For example, during the gait cycle when your weight is on the left leg (stance phase for the left), the right leg is swinging forward (swing phase for the right), so the phase timings are different. You can see this by visually comparing the time points of the left vs. right troughs.

I've googled and SO'ed my way through the problem and I could not find an answer. The closest thing I've found is this but the author is using the same geom_rect among the facets so it is not quite what I want. I attached a simplified Rscript and the data as csv's. Can anybody give me some tips to make this plot?

facet_rects_test.zip (.csv and R Script)

thanks!

Answer 1

I think this is matter of getting the data into the right form.

library(tidyverse) 

First, let's get gait_cycle converted to long format and named properly. Convert Ly and Ry to Left and Right and call the grouping variable side to match the side column in the gaitPoints data frame. Both data frames will then have the same side column that we'll use for facetting, ensuring that corresponding data from each data frame get plotted in the intended facet. The gather function converts the data frame to long format (it's in the tidyr package and is intended to supercede melt from reshape2).

gait_cycle_m = gait_cycle %>% 
  select(-X) %>% 
  rename(Left=Ly, Right=Ry) %>% 
  gather(side, value, -time_ms)

Now we need to get the the three gait Phases set up correctly for plotting. We want a "long" data frame so that we can make a single call to geom_rect and directly map data columns to aesthetics. Thus, we create b (beginning) and e (end) columns that will mark the beginning and end of each phase in the gait cycle. Then we create a Phases column that will become the fill aesthetic (that is, it will mark which phase of the gait each data row represents).

gaitPoints_new = data.frame(swingStart=gait_cycle$time_ms[gaitPoints$swingStart],
                            heelStrike=gait_cycle$time_ms[gaitPoints$heelStrike],
                            toeOff=gait_cycle$time_ms[gaitPoints$toeOff],
                            swingEnd=gait_cycle$time_ms[gaitPoints$swingEnd],
                            side=gaitPoints$side)

gaitPoints_new = bind_rows(gaitPoints_new %>% select(b=1,e=2,5) %>% mutate(Phases="Pre-swing"),
                           gaitPoints_new %>% select(b=2,e=3,5) %>% mutate(Phases="Stance"),
                           gaitPoints_new %>% select(b=3,e=4,5) %>% mutate(Phases="Swing"))

Once we've got the data set up properly, the plot is relatively straightforward. In the code below, we enter the data argument and aes mappings only inside the geom statements, so that there are no issues with aes inheritance.

ggplot() +
  geom_rect(data=gaitPoints_new, aes(xmin=b, xmax=e, ymin=-Inf, max=Inf, fill=Phases), alpha=0.5) +
  geom_line(data=gait_cycle_m, aes(x=time_ms, y=value)) + 
  facet_grid(side ~ .) +
  scale_fill_manual(values=c('firebrick2','orange','steelblue2')) +
  theme_bw() +
  theme(legend.position = "bottom") +
  labs(x="Time (ms)", y="Sensor Values")

Answer 2

The answer using tidyr functions is a great solution. You can, of course, achieve the result you want with the reshape2 package you're already familiar with.

The critical element you were missing is that the faceting variable can be taken from multiple data arguments, as long as it has the same name and levels. The function below works with the data as you read it in (you probably want to put the function definition before its first use in your script, though!).

plotAccelerometerDataWithPhasesSuperimposed <- function(acceldf, phasesdf) {

  # melt the rows for column left/right in order to facet_wrap on it
  acceldf_melted <- melt(acceldf[, c('time_ms', 'Ly', 'Ry')],
                         id.vars = 'time_ms')

  # make the facet variables identical
  phasesdf$variable <- factor(phasesdf$side, levels = c('Left', 'Right'),
                              labels = c('Ly', 'Ry'))

  ggplot(acceldf_melted, aes(x=time_ms, y=value)) +

    # Phases
    geom_rect(data = phasesdf, inherit.aes = FALSE, aes(
      xmin = acceldf$time_ms[swingStart],
      xmax = acceldf$time_ms[heelStrike] - 1,
      ymin = -Inf, ymax = Inf, fill = "Swing"), colour = NA, alpha = 0.3) +
    geom_rect(data = phasesdf, inherit.aes = FALSE, aes(
      xmin = acceldf$time_ms[toeOff],
      xmax = acceldf$time_ms[swingEnd] - 1,
      ymin = -Inf, ymax = Inf, fill = "Pre-swing"), colour = NA, alpha = 0.3) +
    geom_rect(data = phasesdf, inherit.aes = FALSE, aes(
      xmin = acceldf$time_ms[heelStrike],
      xmax = acceldf$time_ms[toeOff] - 1,
      ymin = -Inf, ymax = Inf, fill = "Stance"), colour = NA, alpha = 0.3) +

    # Lines
    facet_grid(variable~., labeller = labeller(
      variable = c(Ly = "Left", Ry = "Right"))) +
    labs(title = "Gait Phases by Accelerometer", x = "time (ms)",
         y = "Sensors Values") +
    geom_line() +
    scale_fill_manual('Phases',
      values = c('firebrick2', 'orange', 'steelblue2'),
      guide = guide_legend()) +
    guides(colour = FALSE) +
    theme(legend.direction = "horizontal", legend.position = "bottom",
          strip.text.y = element_text(size=16, colour = "blue"))
}