r - How to change colours in this heatmap?

Question

I would be very grateful for any help. I have created a heatmap using Pheatmap. My measures are binary and I would like the annotation row colours (5 categories) to be the same as the data points. Currently I have one colour across the 5 categories. I have attached the chart produced by my code. I am not sure how to do this. Thanks in advance!

Here is my code and sample data:

library(pheatmap)
library(dplyr)

*Arrange cluster
spells2=spells%>%arrange(PAM_complete) 

*Df for wheeze columns
whz=spells2%>%dplyr::select(2:6)

*Create separate df for cluster  
c5=spells2$PAM_complete
c5=as.data.frame(c5)

*Wheeze and cluster need the same row names (id)
rownames(whz)=spells2$id
rownames(c5)=spells2$id
c5$c5=as.factor(c5$c5)


col=c("white", "darkblue")
pheatmap(whz,legend_breaks = 0:1, legend_labels = c("No wheeze", "Wheeze"), fontsize = 10,
         show_rownames=FALSE, cluster_rows = FALSE,  color=col,
         cluster_cols=FALSE , annotation_row=c5,  )

> dput(head(spells2, 50))
structure(list(id = c("10003A", "1001", "10012A", "10013A", "10016A", 
"10019A", "1001A", "10023A", "1002A", "10037A", "1004", "10042A", 
"10045A", "1005", "10051A", "10054A", "1006", "10064A", "10065A", 
"10075A", "10076A", "10082A", "10087A", "10094A", "10095A", "10097A", 
"10098A", "100A", "10103A", "10104A", "10106A", "10121A", "10124A", 
"10126A", "10132A", "1013A", "10144A", "10146A", "1014A", "1015", 
"10153A", "10156A", "10159A", "10161A", "1017", "10171A", "10175A", 
"10178A", "1018", "10186A"), whz1 = c(0, 1, 0, 0, 0, 0, 0, 1, 
0, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 
1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0
), whz2 = c(1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 
0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0), whz3 = c(0, 0, 0, 0, 0, 
0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 
0, 0, 0), whz4 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0), whz5 = c(0, 0, 
0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 
0, 0, 0, 0, 0, 0), PAM_complete = c("ETW", "ETW", "NWZ", "NWZ", 
"LOW", "NWZ", "NWZ", "INT", "NWZ", "ETW", "NWZ", "PEW", "ETW", 
"INT", "NWZ", "INT", "ETW", "NWZ", "ETW", "ETW", "NWZ", "ETW", 
"ETW", "NWZ", "NWZ", "NWZ", "NWZ", "NWZ", "NWZ", "PEW", "NWZ", 
"ETW", "NWZ", "INT", "NWZ", "INT", "NWZ", "INT", "NWZ", "LOW", 
"PEW", "NWZ", "NWZ", "INT", "ETW", "NWZ", "ETW", "NWZ", "ETW", 
"NWZ")), row.names = c(NA, -50L), class = c("tbl_df", "tbl", 
"data.frame"))
> 

Answer 1

If I understand you correctly, you have plot "B" below, but you want plot "A" (without the little gaps in between the plots). This is not a straightforward task using the pheatmap package. The approach I used to create plot "A" below might be suitable with some tweaking (basically, plot each group separately then paste them all together in a column). Otherwise, a simpler 'ggplot' method is included below.

library(tidyverse)
library(pheatmap)
library(cowplot)

spells2 <- as.data.frame(spells) %>%
  arrange(PAM_complete)

#Df for wheeze columns
whz <- spells2 %>%
  dplyr::select(2:6)

#Create separate df for cluster  
c5 <- spells2$PAM_complete %>% 
  as.data.frame()
colnames(c5) <- "names"

#Wheeze and cluster need the same row names (id)
rownames(whz) <- spells2$id
rownames(c5) <- spells2$id

c5$names <- as.factor(c5$names)

combined <- cbind(c5, whz)

# To get the 'default' pheatmap colour scheme
gg_color_hue <- function(n) {
  hues = seq(15, 375, length = n + 1)
  hcl(h = hues, l = 75, c = 100)[1:n]
}
scales::show_col(gg_color_hue(5))

# Specify colours for each group
ann_colors = list(
  names = c(ETW = "#FF9289", INT = "#FF8AFF",
            LOW = "#00DB98", NWZ = "#00CBFF",
            PEW = "#BEC100"))


# Generate the plots
col = c("grey95", "darkblue")
p <- pheatmap(whz, legend_breaks = 0:1,
         legend_labels = c("No wheeze", "Wheeze"),
         fontsize = 10, show_rownames = FALSE,
         cluster_rows = FALSE, color = col,
         cluster_cols = FALSE, annotation_row = c5)

col_1 <- c("grey95", "#FF9289")
p1 <- pheatmap(combined %>% filter(names == "ETW") %>% select(-c(names)),
         show_rownames = FALSE, show_colnames = FALSE,
         cluster_rows = FALSE, cluster_cols = FALSE,
         legend = FALSE, annotation_legend = FALSE,
         color = col_1, annotation_names_row = FALSE,
         annotation_colors = ann_colors, 
         annotation_row = combined %>% filter(names == "ETW") %>% select(names))

col_2 <- c("grey95", "#FF8AFF")
p2 <- pheatmap(combined %>% filter(names == "INT") %>% select(-c(names)),
         show_rownames = FALSE, show_colnames = FALSE,
         cluster_rows = FALSE, cluster_cols = FALSE,
         legend = FALSE, annotation_legend = FALSE,
         color = col_2, annotation_names_row = FALSE,
         annotation_colors = ann_colors, cellheight = 7,
         annotation_row = combined %>% filter(names == "INT") %>% select(names))

col_3 <- c("grey95", "#00DB98")
p3 <- pheatmap(combined %>% filter(names == "LOW") %>% select(-c(names)),
               show_rownames = FALSE, show_colnames = FALSE,
               cluster_rows = FALSE, cluster_cols = FALSE,
               legend = FALSE, annotation_legend = FALSE,
               color = col_3, annotation_names_row = FALSE,
               annotation_colors = ann_colors,
               annotation_row = combined %>% filter(names == "LOW") %>% select(names))

# Because all whz values = 0 for NWZ,
# you need to change one value to '1'
# in order for pheatmap to generate a plot
combined[23,2] <- 1

col_4 <- c("grey95", "grey95")
p4 <- pheatmap(combined %>% filter(names == "NWZ") %>% select(-c(names)),
               show_rownames = FALSE, show_colnames = FALSE,
               cluster_rows = FALSE, cluster_cols = FALSE,
               legend = FALSE, annotation_legend = FALSE,
               color = col_4, annotation_names_row = FALSE,
               annotation_colors = ann_colors,
               annotation_row = combined %>% filter(names == "NWZ") %>% select(names))

col_5 <- c("grey95", "#BEC100")
p5 <- pheatmap(combined %>% filter(names == "PEW") %>% select(-c(names)),
               show_rownames = FALSE,
               cluster_rows = FALSE, cluster_cols = FALSE,
               legend = FALSE, annotation_legend = FALSE,
               color = col_5,
               annotation_colors = ann_colors,
               annotation_row = combined %>% filter(names == "PEW") %>% select(names))

heatmaps <- cowplot::plot_grid(p1[[4]], p2[[4]], p3[[4]],
                   p4[[4]], p5[[4]], ncol = 1,
                   rel_heights = c(1.3, 0.7, 0.3, 2.4, 0.8))
cowplot::plot_grid(heatmaps, p$gtable, ncol = 2, rel_widths = c(0.7, 1), labels = "AUTO")

EDIT

If you don't necessarily want to use pheatmap, ggplot2 geom_tile() would be a lot easier, e.g.

library(tidyverse)

my_levels <- rownames(combined)
my_colours <- c("#FF9289", "#FF8AFF", "#00DB98", "#00CBFF", "#BEC100")

combined %>%
  rownames_to_column(var = "IDs") %>% 
  pivot_longer(cols = -c(IDs, names),
               names_to = "Trial",
               values_to = "Wheeze") %>%
  rename(Group = names) %>% 
  mutate(IDs = factor(IDs, levels = my_levels)) %>% 
  ggplot() +
  geom_tile(aes(y = rev(IDs),
                x = Trial,
                fill = Group,
                alpha = Wheeze),
            color = "black") +
  scale_alpha_continuous(breaks = c(0, 1),
                         labels = c("No", "Yes")) +
  scale_fill_manual(values = my_colours) +
  theme_minimal() +
  theme(panel.grid = element_blank())

EDIT 2

To include an 'annotation' bar before the plot, you can use this:

combined %>%
  rownames_to_column(var = "IDs") %>% 
  pivot_longer(cols = -c(IDs, names),
               names_to = "Trial",
               values_to = "Wheeze") %>%
  rename(Group = names) %>% 
  mutate(IDs = factor(IDs, levels = my_levels)) %>% 
  ggplot() +
  geom_tile(aes(y = rev(IDs),
                x = Trial,
                fill = Group,
                alpha = Wheeze),
            color = "black") +
  geom_tile(aes(x = -0.1, y = rev(IDs), fill = Group),
            show.legend = FALSE) +
  coord_cartesian(c(0.8, 5)) +
  scale_fill_manual(values = my_colours) +
  scale_alpha_continuous(breaks = c(0, 1),
                         labels = c("No", "Yes")) +
  theme(plot.margin=unit(c(1,0,0,0), units="lines"))

I wasn't able to label it as "Groups", but I imagine it's possible if you tinker with it.