How to use label_parsed when combining multi-level facets in ggplot2?

[RuReady]

Greetings,

This is what I am after:

• Combine two level facets into one line and parse one level only,
• Add a counter label (1, 2, .etc) for each facet.

Can it be done in ggplot2? Thank you!

My data and code:

library(ggplot2)

df <- tibble::tribble(
  ~Species,  ~Exp,  ~Time, ~ID_var,  ~ID,             ~Value,
  "BAC", "Ex2", "Day2",    "dx", "AA",   5.63714612068672,
  "BAC", "Ex2", "Day2",    "dy", "AA",   7.61893506310032,
  "BAC", "Ex2", "Day1",    "dx", "AA",   18.3522498848947,
  "BAC", "Ex2", "Day1",    "dy", "AA",   9.42305034854746,
  "BAC", "Ex1", "Day2",    "dx", "AA",   11.7654972359352,
  "BAC", "Ex1", "Day2",    "dy", "AA",    1.4096325923608,
  "BAC", "Ex1", "Day1",    "dx", "AA",   4.87888288863884,
  "BAC", "Ex1", "Day1",    "dy", "AA",   6.32602817940025,
  "VIR", "Ex2", "Day2",    "dx", "AA",   11.4046287035643,
  "VIR", "Ex2", "Day1",    "dx", "AA",   5.66495319147555,
  "VIR", "Ex1", "Day2",    "dx", "AA",   13.2081354093821,
  "VIR", "Ex1", "Day1",    "dx", "AA",   2.59305776407893,
  "BAC", "Ex2", "Day2",    "dx", "BB",   5.24976439290446,
  "BAC", "Ex2", "Day2",    "dy", "BB",  -1.12015986445448,
  "BAC", "Ex2", "Day1",    "dx", "BB",   14.0267222669671,
  "BAC", "Ex2", "Day1",    "dy", "BB",   9.92023870701909,
  "BAC", "Ex1", "Day2",    "dx", "BB",   11.5587853288609,
  "BAC", "Ex1", "Day2",    "dy", "BB",   7.22957110204637,
  "BAC", "Ex1", "Day1",    "dx", "BB",   14.3707539662701,
  "BAC", "Ex1", "Day1",    "dy", "BB",   14.2688009251983,
  "VIR", "Ex2", "Day2",    "dx", "BB",   12.3235059212255,
  "VIR", "Ex2", "Day1",    "dx", "BB",    7.1642240175605,
  "VIR", "Ex1", "Day2",    "dx", "BB",   1.40762189059041,
  "VIR", "Ex1", "Day1",    "dx", "BB",   16.2477719898299,
  "BAC", "Ex2", "Day2",    "dx", "CC",   13.6797907100179,
  "BAC", "Ex2", "Day2",    "dy", "CC",   8.49978560116902,
  "BAC", "Ex2", "Day1",    "dx", "CC",   10.5199110839685,
  "BAC", "Ex2", "Day1",    "dy", "CC",   8.82871946790778,
  "BAC", "Ex1", "Day2",    "dx", "CC",   7.64537408604439,
  "BAC", "Ex1", "Day2",    "dy", "CC",   18.0988236265772,
  "BAC", "Ex1", "Day1",    "dx", "CC", -0.292516825381327,
  "BAC", "Ex1", "Day1",    "dy", "CC",   12.5076824978164,
  "VIR", "Ex2", "Day2",    "dx", "CC",   11.2778368965593,
  "VIR", "Ex2", "Day1",    "dx", "CC",   7.00075569798348,
  "VIR", "Ex1", "Day2",    "dx", "CC",   11.6892586717766,
  "VIR", "Ex1", "Day1",    "dx", "CC",   14.5336048072784
)

Plot

p1 <- ggplot(data = df,
             aes(x = ID, y = Time)) +
  geom_point(aes(size = Value, 
                 color = Value,
                 fill = Value), 
             stroke = 0.5,
             shape = 21) +
  guides(size = FALSE, color = FALSE) +
  scale_fill_viridis_c()

var_names <- c(`dx` = "delta[x]",
               `dy` = "delta[y]")

# parsing ok but facet labels are on two different rows
p2 <- p1 +
  facet_grid(Exp ~ Species + ID_var,
             labeller = labeller(ID_var   = as_labeller(var_names, label_parsed)))
p2

# add  .multi_line = FALSE breaks parsing
p3 <- p1 +
  facet_grid(Exp ~ Species + ID_var,
             labeller = labeller(ID_var   = as_labeller(var_names, label_parsed),
                                 .multi_line = FALSE))
p3

[joels]

I've never really grokked anything beyond basic use of the labeller function, so in the rare cases when I need to do something like this, I usually create the expression on the fly as a string in the data itself. Below is an example with your data. We paste together Species and the relevant portion of ID_var (so that we have a single faceting column) and also include the other elements of the desired expression:

library(tidyverse)

df %>% 
  mutate(Species = paste0(Species, "~delta[", substr(ID_var,2,2), "]"),
         Species = paste0(as.numeric(factor(Species)), "*symbol(')')~", Species)) %>% 
  ggplot(aes(x = ID, y = Time)) +
    geom_point(aes(size = Value, color = Value, fill = Value), 
               stroke = 0.5, shape = 21) +
    guides(size = FALSE, color = FALSE) +
    scale_fill_viridis_c() +
    facet_grid(Exp ~ Species, labeller=label_parsed)

[RuReady]

Thank you so much! Is there anyway to keep the original factor order too? For example, if VIR is ahead of BAC, your solution will change the order.

df$Species <- factor(df$Species, levels = c("VIR", "BAC"))

ggplot(data = df, aes(x = ID, y = Time)) +
  geom_point(aes(size = Value, color = Value, fill = Value), 
             stroke = 0.5, shape = 21) +
  guides(size = FALSE, color = FALSE) +
  scale_fill_viridis_c() +
  scale_color_viridis_c() +
  facet_grid(Exp ~ Species + ID_var,
             labeller = labeller(ID_var   = as_labeller(var_names, label_parsed)))

df %>% 
  mutate(Species = paste0(Species, "~delta[", substr(ID_var, 2, 2), "]"),
         Species = paste0(as.numeric(factor(Species)), "*symbol(')')~", Species)) %>% 
  ggplot(aes(x = ID, y = Time)) +
  geom_point(aes(size = Value, color = Value, fill = Value), 
             stroke = 0.5, shape = 21) +
  guides(size = FALSE, color = FALSE) +
  scale_fill_viridis_c() +
  scale_color_viridis_c() +
  facet_grid(Exp ~ Species, labeller = label_parsed)

[joels]

You can get the desired order by sorting the data using the factor ordering of Species and (if necessary) ID_var. Then, after you generate the desired expression string, turn that into a factor and set the factor levels using the current ordering of the data frame. I've done that below in several steps, but I'd be surprised if the code couldn't be shortened.

df %>% 
  arrange(Species, ID_var) %>% 
  mutate(Species2 = Species,
         Species2 = paste0(Species2, "~delta[", substr(ID_var,2,2), "]"),
         Species2 = paste0(as.numeric(factor(Species2, levels=unique(Species2))), "*symbol(')')~", Species2),
         Species2 = factor(Species2, levels=unique(Species2))) %>% 
  ggplot(aes(x = ID, y = Time)) +
    geom_point(aes(size = Value, color = Value, fill = Value), 
               stroke = 0.5, shape = 21) +
    guides(size = FALSE, color = FALSE) +
    scale_fill_viridis_c() +
    facet_grid(Exp ~ Species2, labeller=label_parsed)

[RuReady]

Fantastic! Thanks again!