facet_grid (geom_tile) with different y-axis label order per facet.

[g-pacheco]

Hello.

Thanks a lot for the useful tool!
I would like to ask if it would be possible to use tidytext to generate a facet_grid (geom_tile) where the order of the y-axis label would vary on each facet. It seems that ggplot does allow for this behaviour, but I was wondering if this would be possible with the help of tidytext.

Many thanks in advance, George.

[juliasilge]

Can you create a reprex (a minimal reproducible example) demonstrating what you are trying to do? The goal of a reprex is to make it easier to recreate your problem so that other people can understand it and/or fix it. If you've never heard of a reprex before, you may want to start with the tidyverse.org help page, and you may want to look at the similar questions folks have asked in juliasilge/juliasilge.com#10. Thanks! 🙌

[g-pacheco]

Hello @juliasilge,

Thanks a lot for your attention. Here, I believe, is a reproducible example:

# Loads libraries ~ 
library(tidyverse)
library(ggnewscale)
library(data.table)

# Gets fulldf ~ 
fulldf <- structure(list(Sample_ID_1 = c("Crotone_02", "Crotone_02", "Crotone_02", 
"Crotone_03", "Crotone_03", "Crotone_03", "Crotone_01", "Crotone_01", 
"Crotone_01", "Crotone_02", "Crotone_02", "Crotone_02", "Crotone_01", 
"Crotone_01", "Crotone_01", "Crotone_03", "Crotone_03", "Crotone_03"
), Sample_ID_2 = c("Crotone_02", "Crotone_03", "Crotone_01", 
"Crotone_02", "Crotone_03", "Crotone_01", "Crotone_02", "Crotone_03", 
"Crotone_01", "Crotone_02", "Crotone_03", "Crotone_01", "Crotone_02", 
"Crotone_03", "Crotone_01", "Crotone_02", "Crotone_03", "Crotone_01"
), Population_1 = c("Crotone", "Crotone", "Crotone", "Crotone", 
"Crotone", "Crotone", "Crotone", "Crotone", "Crotone", "Crotone", 
"Crotone", "Crotone", "Crotone", "Crotone", "Crotone", "Crotone", 
"Crotone", "Crotone"), Population_2 = c("Crotone", "Crotone", 
"Crotone", "Crotone", "Crotone", "Crotone", "Crotone", "Crotone", 
"Crotone", "Crotone", "Crotone", "Crotone", "Crotone", "Crotone", 
"Crotone", "Crotone", "Crotone", "Crotone"), CHRType = c("Autosomes", 
"Autosomes", "Autosomes", "Autosomes", "Autosomes", "Autosomes", 
"Autosomes", "Autosomes", "Autosomes", "Autosomes", "Autosomes", 
"Autosomes", "Autosomes", "Autosomes", "Autosomes", "Autosomes", 
"Autosomes", "Autosomes"), K = c("K = 2", "K = 2", "K = 2", "K = 2", 
"K = 2", "K = 2", "K = 2", "K = 2", "K = 2", "K = 3", "K = 3", 
"K = 3", "K = 3", "K = 3", "K = 3", "K = 3", "K = 3", "K = 3"
), Value = c(NA, 0.013115, 0.0546, 0.033063, NA, 0.031474, 0.033063, 
0.033063, NA, NA, -0.007207, 0.039478, 0.0145813333333333, 0.011473, 
NA, 0.0145813333333333, NA, 0.0145813333333333)), row.names = c(NA, 
-18L), class = c("tbl_df", "tbl", "data.frame"))

# Gets corres ~ 
corres <- list(structure(list(Crotone_02 = c(NA, 0.013115, 0.0546), Crotone_03 = c(0.013115, 
NA, 0.031474), Crotone_01 = c(0.0546, 0.031474, NA), Sample_ID_1 = c("Crotone_02", 
"Crotone_03", "Crotone_01"), Population_1 = c("Crotone", "Crotone", 
"Crotone"), CHRType = c("Autosomes", "Autosomes", "Autosomes"
), K = c("K = 2", "K = 2", "K = 2")), row.names = c("Crotone_02", 
"Crotone_03", "Crotone_01"), class = "data.frame"), structure(list(
    Crotone_02 = c(NA, 0.039478, -0.007207), Crotone_01 = c(0.039478, 
    NA, 0.011473), Crotone_03 = c(-0.007207, 0.011473, NA), Sample_ID_1 = c("Crotone_02", 
    "Crotone_01", "Crotone_03"), Population_1 = c("Crotone", 
    "Crotone", "Crotone"), CHRType = c("Autosomes", "Autosomes", 
    "Autosomes"), K = c("K = 3", "K = 3", "K = 3")), row.names = c("Crotone_02", 
"Crotone_01", "Crotone_03"), class = "data.frame"))

# Defines the generate_ordered_permutations function ~ 
generate_ordered_permutations <- function(individuals, k) {
  perm <- do.call(rbind, lapply(individuals, function(id1) {
    data.frame(Sample_ID_1 = id1, Sample_ID_2 = individuals, K = k)}))
  return(perm)}

all_permutations <- do.call(rbind, lapply(seq_along(corres), function(i) {
  individuals <- corres[[i]]$Sample_ID_1
  k <- corres[[i]]$K[1]
  generate_ordered_permutations(individuals, k)}))

# Sets the Order column per K ~
all_permutations <- all_permutations %>%
  group_by(K) %>%
  mutate(Order = match(Sample_ID_1, unique(Sample_ID_1))) %>%
  ungroup()

# Defines the reorder_fulldf function ~
reorder_fulldf <- function(df, permutations) {
  permutations$order <- seq_len(nrow(permutations))
  merged <- merge(permutations, df, by = c("Sample_ID_1", "Sample_ID_2", "K"), all.x = TRUE)
  reordered <- merged[order(merged$order), ]
  reordered$order <- NULL
  return(reordered)}

# Splits fulldf and all_permutations by K ~
split_fulldf <- split(fulldf, fulldf$K)
split_permutations <- split(all_permutations, all_permutations$K)

# Applies the reordering function to each subset of fulldf ~
fulldfUp <- do.call(rbind, lapply(names(split_fulldf), function(k) {
  reordered_df <- reorder_fulldf(split_fulldf[[k]], split_permutations[[k]])
  reordered_df$Order <- split_permutations[[k]]$Order
  return(reordered_df)}))

# Sets factor levels for Sample_ID_1 & Sample_ID_2 per K ~ 
fulldfUp <- fulldfUp %>%
  group_by(K) %>%
  mutate(Sample_ID_1 = factor(Sample_ID_1, levels = unique(Sample_ID_1)),
         Sample_ID_2 = factor(Sample_ID_2, levels = unique(Sample_ID_1))) %>%
  ungroup()

So, you can see that now Sample_ID_1 and Sample_ID_2 are ordered differently per K in fulldfUp. What I would to do is to create a plot using facet_grid like this:

   # Defines color palette and breaks ~
   color_palette <- c("#023858", "#ffffff", "#a50f15")
   nHalf <- 10
   Min <- -.2
   Max <- .2
   Thresh <- 0
    
   rc1 <- colorRampPalette(colors = color_palette[1:2], space = "Lab")(nHalf)
   rc2 <- colorRampPalette(colors = color_palette[2:3], space = "Lab")(nHalf)
   rampcols <- c(rc1, rc2)
   rampcols[c(nHalf, nHalf+1)] <- rgb(t(col2rgb(color_palette[2])), maxColorValue = 256) 
    
   rb1 <- seq(Min, Thresh, length.out = nHalf + 1)
   rb2 <- seq(Thresh, Max, length.out = nHalf + 1)[-1]
   rampbreaks <- c(rb1, rb2)
   
# Creates heatmap ~
ggplot(fulldfUp, aes(x = Sample_ID_1, y = Sample_ID_2, fill = as.numeric(Value))) +
  geom_tile(linewidth = .15, colour = "#000000") +
  scale_fill_gradientn(colors = rampcols, na.value = "#d6d6d6", breaks = c(-.2, 0, .2), limits = c(-.2, .2)) +
  scale_x_discrete(labels = fulldf$Sample_ID_1, expand = c(0, 0), drop = FALSE) +
  scale_y_discrete(labels = fulldf$Sample_ID_2, expand = c(0, 0), drop = FALSE) +
  facet_grid(K ~ CHRType, scales = "free", space = "free") +
  theme(panel.background = element_rect(fill = "#ffffff"),
        panel.border = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.spacing = unit(1, "lines"),
        legend.position = "right",
        legend.key = element_blank(),
        legend.background = element_blank(),
        legend.margin = margin(t = 0, b = 0, r = 15, l = 15),
        legend.box = "vertical",
        legend.box.margin = margin(t = 20, b = 30, r = 0, l = 0),
        axis.title = element_blank(),
        axis.text.x = element_text(color = "#000000", family = "Optima", size = 12, face = "bold", angle = 45, vjust = 1, hjust = 1),
        axis.text.y = element_text(color = "#000000", family = "Optima", size = 9, face = "bold"),
        axis.ticks.x = element_blank(),
        axis.ticks.y = element_line(color = "#000000", linewidth = .15),
        strip.text = element_text(colour = "#000000", size = 18, face = "bold", family = "Optima"),
        strip.background = element_rect(colour = "#000000", fill = "#d6d6d6", linewidth = .15),
        axis.line = element_line(colour = "#000000", linewidth = .15)) +
  guides(fill = guide_colourbar(title = "", title.theme = element_text(size = 16, face = "bold"),
                                label.theme = element_text(size = 10, face = "bold"), label.position = "right",
                                barwidth = 1.25, barheight = 18, order = 1, frame.linetype = 1, frame.colour = NA,
                                ticks.colour = NA, direction = "vertical", even.steps = TRUE,
                                draw.ulim = TRUE, draw.llim = TRUE))

However, as you can see below the order is always the same in both facets: Crotone_02; Crotone_03 and Crotone_01. I was wondering if there would be a way to plot this by conserving the order of Sample_ID_1 and Sample_ID_2in each facet.

Kind regards, George.

[juliasilge]

That example is a little complicated. Can you take a look at this and explain what it is you are wanting to do?

library(tidyverse)

df <- data.frame(
  col1 = factor(sample(c("a", "b", "c"), 20, replace = TRUE)),
  col2 = factor(sample(c("x", "y", "z"), 20, replace = TRUE)),
  col3 = rnorm(20),
  col4 = sample(c("grid_a", "grid_b"), 20, replace = TRUE),
  col5 = sample(c("grid_c", "grid_d"), 20, replace = TRUE)
)

df |> 
  ggplot(aes(col1, col2)) +
  facet_grid(col4 ~ col5, scales = "free", space = "free") +
  geom_tile(aes(fill = col3))

^{Created on 2025-01-15 with reprex v2.1.1}

Are you wanting to order col2 by col3 within... what? I'm a bit confused.

[g-pacheco]

Hello @juliasilge,

Apologies for my confusing example and thanks for providing a much simpler one.

Continuing with your example... I would like to reorder the permutations (col1 and col2) within col4, for example. Thus, the y-axis order could be say (z, y, x) in grid_a while being (y, z, x) in grid_b.

I would like to be able to plot the different grids with specific y-axis orders based on the same data frame.

Is my intention clearer now?

Kind regards, George.

[juliasilge]

That definitely works! You can do that like so:

library(tidyverse)
library(tidytext)

df <- data.frame(
  col1 = factor(sample(c("a", "b", "c"), 20, replace = TRUE)),
  col2 = factor(sample(c("x", "y", "z"), 20, replace = TRUE)),
  col3 = rnorm(20),
  col4 = sample(c("grid_a", "grid_b"), 20, replace = TRUE),
  col5 = sample(c("grid_c", "grid_d"), 20, replace = TRUE)
)

df |> 
  mutate(col2 = reorder_within(col2, col3, col4)) |> 
  ggplot(aes(col1, col2)) +
  facet_grid(col4 ~ col5, scales = "free", space = "free") +
  geom_tile(aes(fill = col3)) +
  scale_y_reordered()

^{Created on 2025-01-17 with reprex v2.1.1}

[g-pacheco]

Hello @juliasilge,

Thanks a lot. I can indeed replicate your code. However, when I try to adapt to mine it does not work. Thus, I believe I am doing something wrong. Would you be so kind as to tell me what that would be?

Kind regards, George.

fulldfUp <- structure(list(Sample_ID_1 = c("Crotone500", "Crotone500", "Crotone500", 
"Crotone501", "Crotone501", "Crotone501", "Crotone498", "Crotone498", 
"Crotone498", "Crotone500", "Crotone500", "Crotone500", "Crotone498", 
"Crotone498", "Crotone498", "Crotone501", "Crotone501", "Crotone501"
), Sample_ID_2 = c("Crotone500", "Crotone501", "Crotone498", 
"Crotone500", "Crotone501", "Crotone498", "Crotone500", "Crotone501", 
"Crotone498", "Crotone500", "Crotone498", "Crotone501", "Crotone500", 
"Crotone498", "Crotone501", "Crotone500", "Crotone498", "Crotone501"
), K = c("K = 2", "K = 2", "K = 2", "K = 2", "K = 2", "K = 2", 
"K = 2", "K = 2", "K = 2", "K = 3", "K = 3", "K = 3", "K = 3", 
"K = 3", "K = 3", "K = 3", "K = 3", "K = 3"), Order = c(1L, 1L, 
1L, 2L, 2L, 2L, 3L, 3L, 3L, 1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L
), Population_1 = c("Crotone", "Crotone", "Crotone", "Crotone", 
"Crotone", "Crotone", "Crotone", "Crotone", "Crotone", "Crotone", 
"Crotone", "Crotone", "Crotone", "Crotone", "Crotone", "Crotone", 
"Crotone", "Crotone"), Population_2 = c("Crotone", "Crotone", 
"Crotone", "Crotone", "Crotone", "Crotone", "Crotone", "Crotone", 
"Crotone", "Crotone", "Crotone", "Crotone", "Crotone", "Crotone", 
"Crotone", "Crotone", "Crotone", "Crotone"), CHRType = structure(c(1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L), levels = c("Autosomes", "Chromosome Z"), class = c("ordered", 
"factor")), Value = c(NA, 0.013115, 0.0546, 0.033063, NA, 0.031474, 
0.033063, 0.033063, NA, NA, 0.039478, -0.007207, 0.0145813333333333, 
NA, 0.011473, 0.0145813333333333, 0.0145813333333333, NA), Sample_ID_Factor = c(1, 
1, 1, 2, 2, 2, 3, 3, 3, 1, 1, 1, 3, 3, 3, 2, 2, 2), Triangle = c("Diagonal", 
"Individual", "Individual", "Population", "Diagonal", "Individual", 
"Population", "Population", "Diagonal", "Diagonal", "Individual", 
"Individual", "Population", "Diagonal", "Individual", "Population", 
"Population", "Diagonal")), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -18L))

fulldfUp |>
  mutate(Sample_ID_2 = reorder_within(Sample_ID_2, as.numeric(Value), K)) |>
  ggplot(aes(Sample_ID_1, Sample_ID_2)) +
  facet_grid(K ~ ., scales = "free", space = "free") +
  geom_tile(data = subset(fulldfUp, Triangle == "Population"), aes(fill = as.numeric(Value)), linewidth = 0) +
  geom_tile(data = subset(fulldfUp, Triangle != "Population"), aes(fill = as.numeric(Value)), linewidth = .15, colour = "#000000") +
  scale_y_reordered()

[juliasilge]

I think you'll need to not pass in a separate data argument to your geom functions, because then it's not using the dataset that you have applied reorder_within() to.