Adding a black outline for each x category in heat map in R-CodePudding

Here is my data which produces a heat map. What I am hoping to do is produce multiple difference heatmaps with an outline around each of x categories.

data <- data.frame(id=c("john","john","john","kate","kate","kate","chris","chris","chris"),
                  group=c("geo","his","math","geo","his","math","geo","his","math"),
                   grade=c(65,76,87,67,89,98,99,97,96),
                   class=c("A","A","A","A","A","A","B","B","B"))

data

mine.heatmap <- ggplot(data = data, mapping = aes(x = id, y = group, fill = grade))  
  geom_tile()  
  xlab(label = "id")   
  ylab(label="group")  
  labs(fill="grade") 
  scale_fill_gradient2(low = "#800080",
                       high = "#FF8C00",mid = "white")


x <- mine.heatmap   facet_grid(
  cols = vars(class), scales = "free", space = "free"
)

 x   theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1, size = 18, margin = margin(b=2))) 
  theme(axis.text.y= element_text(angle = 0, vjust = 0.5, hjust=1, size = 18))  
  theme(legend.text = element_text(size=14)) 
  theme(legend.title = element_text(size=14)) 
  theme(strip.text = element_text(size=14)) 
  theme(axis.title.x = element_text(size=18))  theme(axis.title.y = element_text(size=18))

Original Heat map:

What I am hoping to get are the following heatmaps:

CodePudding user response：

One option to achieve your desired result would be to

put your plotting code in a function which takes as one argument the id for which you want to draw a outline.
Use some data wrangling to convert the categories to be plotted on the x and y aes to numerics per facet variable.
Add a geom_rect to your plotting code to draw the outline which uses the numerics computed in step 2.

library(ggplot2)
library(dplyr)

mine_heatmap <- function(x) {
  p <- ggplot(data = data, mapping = aes(x = id, y = group, fill = grade))  
    geom_tile()  
    # Add outline via a geom_rect
    geom_rect(
      data = subset(data, id == x),
      aes(
        xmin = id_num - .5, xmax = id_num   .5,
        ymin = min(group_num) - .5, ymax = max(group_num)   .5
      ), fill = NA, color = "black", size = 1
    )  
    labs(x = "id", y = "group", fill = "grade")  
    scale_fill_gradient2(
      low = "#800080",
      high = "#FF8C00", mid = "white"
    )

  p <- p   facet_grid(
    cols = vars(class), scales = "free", space = "free"
  )

  p   theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1, size = 18, margin = margin(b = 2)))  
    theme(axis.text.y = element_text(angle = 0, vjust = 0.5, hjust = 1, size = 18))  
    theme(legend.text = element_text(size = 14))  
    theme(legend.title = element_text(size = 14))  
    theme(strip.text = element_text(size = 14))  
    theme(axis.title.x = element_text(size = 18))   theme(axis.title.y = element_text(size = 18))
}

# Convert id and group to numerics per facet variable
data <- data |>
  group_by(class) |>
  mutate(
    id_num = as.numeric(factor(id)),
    group_num = as.numeric(factor(group))
  ) |>
  ungroup()

mine_heatmap("john")


mine_heatmap("kate")


mine_heatmap("chris")