gheatmap function (ggtree package) returns "Error: Must request at least one colour from a hue palette." when plotting the gheatmap object

Question

I'm trying to add a heat map onto a phylogenic tree using the ggtree function gheatmap. Despite no apparent errors appearing in the lines that create the gheatmap object, when trying to plot the object, it returns "Error: Must request at least one colour from a hue palette.". Still get this error when I use all default values for the arguments of gheatmap (including colour choices), a simpler tree and some random values corresponding to the tips of the tree. I have also tried changing some of the colours and that still didn't fix the error as I'm still unsure which argument is causing the problem.

Here is what I hope is a reproducible example:

library(ggtree)
test.tree <- read.tree(text = "(((A,C), (B,D)), E);")
test.data <- data.frame('taxon' = c('A','B','C','D','E'), 'height' = c(0.7, 0.2, 1.3, 0.55, 0.88))
test.tree.plot <- ggtree(test.tree)

test.plot <- gheatmap(
  test.tree.plot,
  test.data,
  offset = 0,
  width = 1,
  low = "green",
  high = "red",
  color = "white",
  colnames = TRUE,
  colnames_position = "bottom",
  colnames_angle = 0,
  colnames_level = NULL,
  colnames_offset_x = 0,
  colnames_offset_y = 0,
  font.size = 4,
  family = "",
  hjust = 0.5,
  legend_title = "value"
)

plot(test.plot)

Answer 1

welcome to SO!

A quick search for this error point to a case when a variable containing only NA is being mapped to an aesthetic (in this case the fill of geom_tile()). Your data does not have any NA's so its probably something happening inside the gheatmap function.

Taking a closer look, on this line https://github.com/YuLab-SMU/ggtree/blob/232394961afb6ce62c8dd90a5b1ee8e5f557185a/R/gheatmap.R#L81 the gheatmap function is expecting that the data frame will have rownames. Except, in your case, the data do not have rownames which results with all NAs after pivoting with gather few steps down the way.

I updated the function to take another argument id_col which sets the column to use for rownames.

With the new function, the code would be:

library(ggtree)
library(magrittr)
library(dplyr)
library(tidyr)
library(ggplot2)
source("ggheatmap.R") # loading the new function (if in a separate file)

test.tree <- read.tree(text = "(((A,C), (B,D)), E);")
test.data <- data.frame('taxon' = c('A','B','C','D','E'), 
                        'height' = c(0.7, 0.2, 1.3, 0.55, 0.88)
                        )
test.tree.plot <- ggtree(test.tree)

test.plot <- ggheat(
  test.tree.plot,
  test.data,
  id_col = "taxon", # here is where you set the column with species names
                    # this becomes rownames internaly 
                    # and is matched to the tip names
  offset = -3,
  width = 1,
  low = "green",
  high = "red",
  color = "white",
  colnames = TRUE,
  colnames_position = "bottom",
  colnames_angle = 0,
  colnames_level = NULL,
  colnames_offset_x = 0,
  colnames_offset_y = 0,
  font.size = 4,
  family = "",
  hjust = 0.5,
  legend_title = "value"
)

plot(test.plot)

This code makes this image:

The updated function is here:

ggheat <-
  function (p,
            data,
            id_col,
            offset = 0,
            width = 1,
            low = "green",
            high = "red",
            color = "white",
            colnames = TRUE,
            colnames_position = "bottom",
            colnames_angle = 0,
            colnames_level = NULL,
            colnames_offset_x = 0,
            colnames_offset_y = 0,
            font.size = 4,
            family = "",
            hjust = 0.5,
            legend_title = "value")
  {
    colnames_position %<>% match.arg(c("bottom", "top"))
    variable <- value <- lab <- y <- NULL
    width <-
      width * (p$data$x %>% range(na.rm = TRUE) %>% diff) / ncol(data)
    isTip <- x <- y <- variable <- value <- from <- to <- NULL
    df <- p$data
    nodeCo <-
      intersect(
        df %>% filter(is.na(x)) %>% select(.data$parent,
                                           .data$node) %>% unlist(),
        df %>% filter(!is.na(x)) %>%
          select(.data$parent, .data$node) %>% unlist()
      )
    labCo <-
      df %>% filter(.data$node %in% nodeCo) %>% select(.data$label) %>%
      unlist()
    selCo <- intersect(labCo, rownames(data))
    isSel <- df$label %in% selCo
    df <- df[df$isTip | isSel,]
    start <- max(df$x, na.rm = TRUE) + offset
    dd <- as.data.frame(data)
    i <- order(df$y)
    i <- i[!is.na(df$y[i])]
    lab <- df$label[i]
    
    # drop any rownames, then add them based on the user set id column
    # so the matching downstream can work
    dd <- dd %>% tibble::remove_rownames() %>% tibble::column_to_rownames(id_col)
    
    
    dd <- dd[match(lab, rownames(dd)), , drop = FALSE]
    dd$y <- sort(df$y)
    dd$lab <- lab
    dd <- gather(dd, variable, value,-c(lab, y))
    i <- which(dd$value == "")
    if (length(i) > 0) {
      dd$value[i] <- NA
    }
    if (is.null(colnames_level)) {
      dd$variable <- factor(dd$variable, levels = colnames(data))
    }
    else {
      dd$variable <- factor(dd$variable, levels = colnames_level)
    }
    V2 <- start + as.numeric(dd$variable) * width
    mapping <- data.frame(from = dd$variable, to = V2)
    mapping <- unique(mapping)
    dd$x <- V2
    dd$width <- width
    dd[[".panel"]] <- factor("Tree")
    if (is.null(color)) {
      p2 <- p + geom_tile(
        data = dd,
        aes(x, y, fill = value),
        width = width,
        inherit.aes = FALSE
      )
    }
    else {
      p2 <- p + geom_tile(
        data = dd,
        aes(x, y, fill = value),
        width = width,
        color = color,
        inherit.aes = FALSE
      )
    }
    if (is(dd$value, "numeric")) {
      p2 <- p2 + scale_fill_gradient(
        low = low,
        high = high,
        na.value = NA,
        name = legend_title
      )
    }
    else {
      p2 <- p2 + scale_fill_discrete(na.value = NA, name = legend_title)
    }
    if (colnames) {
      if (colnames_position == "bottom") {
        y <- 0
      }
      else {
        y <- max(p$data$y) + 1
      }
      mapping$y <- y
      mapping[[".panel"]] <- factor("Tree")
      p2 <- p2 + geom_text(
        data = mapping,
        aes(x = to, y = y,
            label = from),
        size = font.size,
        family = family,
        inherit.aes = FALSE,
        angle = colnames_angle,
        nudge_x = colnames_offset_x,
        nudge_y = colnames_offset_y,
        hjust = hjust
      )
    }
    p2 <- p2 + theme(legend.position = "right")
    if (!colnames) {
      p2 <- p2 + scale_y_continuous(expand = c(0, 0))
    }
    attr(p2, "mapping") <- mapping
    return(p2)
  }