R热图:使用(ggplot2或按图)有条件地更改标签文本的颜色

时间:2019-11-28 02:26:22

标签: r ggplot2 plotly heatmap

我正在尝试在R中使用 ggplot2 plotly 生成热图,其中将与块或图块关联的值用作相应磁贴中的标签。这并不是很困难,但是我删除了图例,并希望根据标签的值更改标签的颜色,以增加其可见性。

这里有一个可重复的例子来说明我的意思。

数据(使用data.table和dplyr):

sig <-  rep(c("sig1", "sig2", "sig3"), 100, replace = TRUE, prob = c(0.4, 0.35, 0.25))
date <- c("2019-11-01", "2019-11-02", "2019-11-03")

another <- as.data.table(expand.grid(sig, date))

test_dat_numerics <- another[, number_ok := sample(0:100, 900, replace = TRUE)]
setnames(test_dat_numerics, c("Var1", "Var2"), c("sig", "date"))

test_dat_numerics <- test_dat_numerics[, avg := mean(number_ok), by = .(date, sig)] %>%
  dplyr::select(-number_ok) %>%
  dplyr::rename(number_ok = avg) %>%
  dplyr::mutate(prop = ifelse(number_ok > 50, 1, 0))
  dplyr::distinct()

热图(带有ggplot2):

ggp <- ggplot(test_dat_numerics, aes(date, sig, fill = number_ok)) +
  geom_tile() +
  geom_text(aes(label = test_dat_numerics$number_ok)) +
  theme(legend.position="none")

这导致

enter image description here

块越黑,文本越不可见。为防止这种情况,我的目的是在值小于50时将文本设置为白色,否则将其设置为黑色。这是我直到今天都因ggplot2而失败的情节,将不胜感激。

用情节:

p <- test_dat_numerics %>%
  plot_ly(type = "heatmap",
          x = ~date,
          y = ~sig,
          z = ~number_ok,
          # zmax = 100,
          # zmin = 0,
          showscale = FALSE,
          colorscale = "Blues") %>%
  add_annotations(text = as.character(test_dat_numerics$number_ok),
                  showarrow = FALSE,
                  color = list(if (test_dat_numerics$number_ok[i] > 50) {"black"} else {"white"})) %>%
  layout(title = "Test Heatmap",
         # titlefont = t,
         xaxis = list(title = "Datum"), yaxis = list(title = "Signal")
         )

我找到了一个很好的示例here,但是我无法为我的案子工作。这是我的代码的注释部分:

ann <- list()

    for (i in 1:length(unique(test_dat_numerics$sig))) {
      for (j in 1:length(unique(test_dat_numerics$date))) {
        for (k in 1:(length(unique(test_dat_numerics$sig))*length(unique(test_dat_numerics$date)))) {
          ann[[k]] <- list(
          x = i,
          y = j,
          font = list(color = if (test_dat_numerics$number_ok[i] > 50) {"black"} else {"white"}),
          text = as.character(test_dat_numerics$number_ok[[k]]),
          xref = "x", 
          yref = "y", 
          showarrow = FALSE )
        }
      }
    }

p_test_num_heat <- layout(p, annotations = ann)

这是ggplot2的众多尝试之一:

ggp <- ggplot(test_dat_numerics, aes(date, sig, fill = number_ok)) +
  geom_tile() +
  geom_text(aes(label = test_dat_numerics$number_ok)) +
  geom_label(aes(colour = factor(test_dat_numerics$prop))) +
  theme(legend.position="none")

(如果删除倒数第二行,此代码将在上图中生成图。)

我非常喜欢这个……预先感谢您的任何建议!

1 个答案:

答案 0 :(得分:0)

对于ggplot2,您可以在colour(+ aes)的geom_text中使用scale_colour_manual

ggplot(test_dat_numerics, aes(date, sig, fill = number_ok)) +
  geom_tile() +
  geom_text(aes(label = number_ok, colour =ifelse(number_ok>50, "black", "white"))) +
  scale_colour_manual(values=c("white"="white", "black"="black")) +
  theme(legend.position="none")

enter image description here

相关问题