gheatmap 函數（ggtree 包）返回“錯誤：必須從色調調色板中請求至少一種顏色。” 繪制 gheatmap 對象時

Question

我正在嘗試使用 ggtree 函數 gheatmap 將熱圖添加到系統發育樹上。 盡管創建 gheatmap 對象的行中沒有出現明顯錯誤，但在嘗試繪制對象時，它返回“錯誤：必須從色調調色板中請求至少一種顏色。”。 當我使用 gheatmap 參數的所有默認值（包括顏色選擇）、一個更簡單的樹和一些對應於樹尖的隨機值時，仍然會出現此錯誤。 我也嘗試過更改一些顏色，但仍然沒有解決錯誤，因為我仍然不確定是哪個參數導致了問題。

這是我希望是一個可重現的例子：

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

歡迎來到 SO！

對此錯誤的快速搜索指向一種情況，即僅包含NA的變量被映射到美學（在這種情況下是geom_tile()的fill ）。 您的數據沒有任何NA ，因此它可能在gheatmap函數內部發生了一些事情。

仔細看看，在這條線上https://github.com/YuLab-SMU/ggtree/blob/232394961afb6ce62c8dd90a5b1ee8e5f557185a/R/gheatmap.R#L81 gheatmap函數期望數據框將具有rownames 。 除了，在您的情況下，數據沒有行名，這些行名在使用gather旋轉幾步后會產生所有NA 。

我更新了該函數以采用另一個參數id_col ，該參數將列設置為用於行名。

使用新功能，代碼將是：

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)

此代碼使此圖像：

更新的功能在這里：

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)
  }