ggplot2heatmapgeom-tile

Split tiles with geom_tile (ggplot) with fill gradient

I am trying to replicate this kind of plot using ggplot.

Example of plot I want to replicate using ggplot.

To achieve that, I need to have only the diagonal tiles as triangles. I have a single data frame with two batches of data.

    df$Triangle == "Individual" (top triangle)
    df$Triangle == "Population" (bottom triangle)

Here is my current code:

# Defines colour palette and breaks ~
color_palette <- c("#001260", "#EAEDE9", "#601200")
nHalf <- 4
Min <- -.1
Max <- .1
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 Ind_PLot ~
    Ind_Plot <-
      ggplot() + 
      geom_tile(data = subset(fulldf, Triangle == "Individual"), aes(Ind_1, Ind_2, fill = as.numeric(Value)), colour = "#000000")  +
      scale_x_discrete(expand = c(0, 0)) +
      scale_y_discrete(expand = c(0, 0)) +
      scale_fill_gradientn(colors = rampcols, breaks = rampbreaks, limits = c(-.1, .1)) +
      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", size = 16, face = "bold", angle = 45, vjust = 1, hjust = 1),
            axis.text.y = element_text(color = "#000000", size = 16, face = "bold"),
            axis.ticks = element_line(color = "#000000", linewidth = .3),
            strip.text = element_text(colour = "#000000", size = 24, face = "bold", family = "Optima"),
            strip.background = element_rect(colour = "#000000", fill = "#d6d6d6", linewidth = .3),
            axis.line = element_line(colour = "#000000", linewidth = .3)) +
      guides(fill = guide_legend(title = "", title.theme = element_text(size = 16, face = "bold"),
                                 label.theme = element_text(size = 15), reverse = TRUE))


# Creates Mean_PLot ~
    Mean_Plot <-
      ggplot() + 
      geom_tile(data = subset(fulldf, Triangle == "Population"), aes(Population_1, Population_2, fill = as.numeric(Value)), colour = "#000000")  +
      scale_x_discrete(limits = rev, expand = c(0, 0)) +
      scale_y_discrete(limits = rev, expand = c(0, 0)) +
      scale_fill_gradientn(colors = rampcols, breaks = rampbreaks, limits = c(-.1, .1)) +
      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", size = 16, face = "bold", angle = 45, vjust = 1, hjust = 1),
            axis.text.y = element_text(color = "#000000", size = 16, face = "bold"),
            axis.ticks = element_line(color = "#000000", linewidth = .3),
            strip.text = element_text(colour = "#000000", size = 24, face = "bold", family = "Optima"),
            strip.background = element_rect(colour = "#000000", fill = "#d6d6d6", linewidth = .3),
            axis.line = element_line(colour = "#000000", linewidth = .3)) +
      guides(fill = guide_legend(title = "", title.theme = element_text(size = 16, face = "bold"),
                                 label.theme = element_text(size = 15), reverse = TRUE))

You can download a dummy fulldf from here.

Does anyone know if it is possible to replicate this behaviour in ggplot?

Many thanks in advance, George.

Solution

  • Here is one possible option which uses geom_polygon to draw the triangles for the diagonal. Also note that I use a geom_point to draw the individual plot:

    fulldf <- readr::read_tsv(
  "https://raw.githubusercontent.com/g-pacheco/TEMP/1b93c734472fb5282ba6a1ea7fff57fb5b3699d6/fulldf.csv"
)

library(ggplot2)
library(dplyr, warn = FALSE)

dat_ind <- fulldf |>
  filter(Triangle == "Individual") |>
  mutate(
    x = as.numeric(factor(Population_1)),
    y = as.numeric(factor(Population_2))
  ) |>
  split(~ Population_1 + Population_2, drop = TRUE) |>
  lapply(\(x) {
    x |>
      mutate(
        x = x + .5 * scales::rescale(
          as.numeric(factor(Ind_1)),
          to = c(-1, 1)
        ),
        y = y + .5 * scales::rescale(
          as.numeric(factor(Ind_2)),
          to = c(-1, 1)
        )
      )
  }) |>
  bind_rows()

make_polygon1 <- function(x, y, Value) {
  data.frame(
    x = x + .5 * c(1, 1, -1),
    y = y + .5 * c(1, -1, -1),
    Value = Value
  )
}

dat_pop_diag <- fulldf |>
  filter(Triangle == "Population", Population_1 == Population_2) |>
  mutate(
    x = as.numeric(factor(Population_2)),
    y = as.numeric(factor(Population_1))
  ) |>
  reframe(
    make_polygon1(x, y, Value),
    .by = c(Population_1, Population_2, CHRType, K)
  )

make_polygon2 <- function(x, y) {
  data.frame(
    x = x - .5 * c(1, 1, -1),
    y = y - .5 * c(1, -1, -1)
  )
}

dat_ind_diag <- fulldf |>
  filter(Triangle == "Population", Population_1 == Population_2) |>
  mutate(
    x = as.numeric(factor(Population_1)),
    y = as.numeric(factor(Population_2))
  ) |>
  reframe(
    make_polygon2(x, y),
    .by = c(Population_1, Population_2, CHRType, K)
  )

ggplot() +
  geom_polygon(
    data = dat_pop_diag,
    aes(x, y, group = interaction(Population_1, Population_2), fill = Value),
    colour = "#000000",
    linewidth = .1,
  ) +
  geom_tile(
    data = filter(fulldf, Triangle == "Population", Population_1 != Population_2),
    aes(
      Population_2,
      Population_1,
      fill = Value
    ), colour = "#000000"
  ) +
  # Individual plot
  geom_point(
    data = dat_ind,
    aes(
      x, y,
      color = Value
    ),
    size = .25,
    shape = 15
  ) +
  # Upper Triangle Grid
  geom_tile(
    data = filter(fulldf, Triangle == "Population", Population_1 != Population_2),
    aes(Population_1, Population_2), fill = NA, colour = "#000000"
  ) +
  geom_polygon(
    data = dat_ind_diag,
    aes(x, y, group = interaction(Population_1, Population_2)),
    colour = alpha("#000000", .7),
    linewidth = .1,
    fill = NA
  ) +
  scale_x_discrete(expand = c(0, 0)) +
  scale_y_discrete(expand = c(0, 0)) +
  scale_fill_gradientn(
    colors = rampcols, breaks = rampbreaks, limits = c(-.1, .1),
    aesthetics = c("color", "fill"),
    guide = guide_legend(
      title = "", title.theme = element_text(size = 16, face = "bold"),
      label.theme = element_text(size = 15), reverse = TRUE
    ),
    na.value = "transparent"
  ) +
  facet_grid(K ~ CHRType, scales = "free", space = "free") +
  theme(
    axis.text.x = element_text(angle = 90)
  )