我可以使用 geom_text 将静态标签添加到 ggplotly 交互式图表吗

Question

我构建了这个漂亮的 geom_point 图，用于标记特定点

我现在正在尝试使用 ggplotly 使所有点（包括粉红色的点）动态化。我收到此警告消息：

在geom2trace.default(dots[[1L]][[1L]],dots[[2L]][[1L]], dots[[3L]][[1L]]) : geom_GeomTextRepel() 尚未实现 巧妙地。如果你想看到这个 geom 的实现，请打开 您的示例代码存在问题
https://github.com/ropensci/plotly/issues

互动剧情看起来还不错，但存在三个问题：

1. 字幕消失
2. geom_text_repel 的粉色静态文本标签也不见了
3. stat_cor 的结果是扭曲的，它们应该显示相关性的 r 和 p 值

是否有解决方法，或者我必须在没有 plotly 的统计图或没有静态标签的交互式图之间进行选择？

我的代码：

p <- df %>%
  ggplot(aes(x, y, size = z)) +
  geom_point(data=subset(df, a %in% c("a", "b", "c")), 
             aes(x, y,
             text = paste("", a, "\n",    #the text label is here for the benefit of ggploty
                          "x: ", x, "\n", #It is not in the global aes because putting it there removes the entire stat_cor label 
                          "y: ", y, "\n",
                          "z: ", z, "\n",
                          sep = "")), 
             color = "hotpink") +
  geom_point(data=subset(df, !(a %in% c("a", "b", "c"))), 
             aes(x, y,
             text = paste("", a, "\n",    #the text label is here for the benefit of ggploty
                          "x: ", x, "\n", #It is not in the global aes because putting it there removes the entire stat_cor label
                          "y: ", y, "\n",
                          "z: ", z, "\n",
                          sep = "")), 
             color = "steelblue") +
  geom_text_repel(data=subset(df, a %in% c("a", "b", "c")), 
                  aes(label=a), color="hotpink", size=5, fontface ="bold", point.padding = TRUE) +
  ggtitle("Nice Plot!",
          subtitle = "Point Sizes Vary Based On z") +
  xlab("x label") + ylab("y label") +
  labs(size = "z label") +
  theme_minimal() +
  theme(plot.title = element_text(face = "bold", color = "darkgrey", hjust = .5, size = 15),
        plot.subtitle = element_text(face = "italic", color = "darkgrey", hjust = .5, size = 13),
        legend.position = "top", 
        legend.title = element_text(face = "bold", color = "steelblue", size = 12),
        legend.text = element_text(face = "bold", color = "steelblue", size = 12),
        axis.text = element_text(face = "bold", color = "darkgrey", hjust = .5, size = 12),
        axis.title = element_text(face = "bold", color = "darkgrey", hjust = .5, size = 12)) +
  stat_cor(method = "pearson", label.x = 10, label.y = 90, color = "steelblue", size =6) 
p #shows subtitle, and labels pink poiints with geom_text_repel

# Three issues: 
#1) subtitle dissappears 
#2) pink static text labels from geom_text_repel are also gone 
#3) the results from stat_cor are warped, they should show the r and pvalues from the correlation
ggplotly(p, tooltip = "text") %>% 
  config(displayModeBar = F)  

Answer 1

一般情况下，plotly 不支持从ggrepel 和ggpubr 转换结果以及字幕，因此您必须找到替代方案来解决此问题。

这是一种保持大部分 ggplot 对象相同的方法，并且只为 plotly 修改了一些内容：

静态图：

invisible(lapply(c("ggplot2", "plotly", "dplyr", "ggrepel"),
                 require, character.only = TRUE))
# mock data
set.seed(1)
df <- data.frame(x=rnorm(26, mean=55, sd=15),
                 y=rnorm(26, mean = 50, sd=10),
                 z=rnorm(26, mean=40, sd=30),
                 a=c(letters[1:3], rep(NA_character_, 23)),
                 cl=c(rep("a", 3), rep("b", 23)))



p <- df %>%
    ggplot(aes(x, y, size = z, colour=cl)) +
    scale_colour_manual(values=c("hotpink", "steelblue"))+
    # stat_cor(method = "pearson", label.x = 10, label.y = 90, color = "steelblue", size =6)+
    geom_point()+
    annotate("text", label=paste0("R = ", round(with(df, cor.test(x, y))$estimate, 2),
                         ", p = ", round(with(df, cor.test(x, y))$p.value, 3)), x = min(df$x) + 10, y = max(df$y) + 10, color="steelblue", size=5)+
    labs(title = "Nice Plot!",
         subtitle = "Point Sizes Vary Based On z",
         size = "z label",
         x = "x label",
         y = "y label")  +
    theme_minimal() +
    theme(plot.title = element_text(face = "bold", color = "darkgrey", hjust = .5, size = 15),
          plot.subtitle = element_text(face = "italic", color = "darkgrey", hjust = .5, size = 13),
          legend.position = "top", 
          legend.title = element_text(face = "bold", color = "steelblue", size = 12),
          legend.text = element_text(face = "bold", color = "steelblue", size = 12),
          axis.text = element_text(face = "bold", color = "darkgrey", hjust = .5, size = 12),
          axis.title = element_text(face = "bold", color = "darkgrey", hjust = .5, size = 12))+ 
    guides(size = guide_legend(override.aes = list(colour = "steelblue")),
           colour=FALSE)

p + geom_text_repel(aes(label=a), color="hotpink", size=5, fontface ="bold", point.padding = 1)
#> Warning: Removed 23 rows containing missing values (geom_text_repel).

这里，我没有使用ggpubr stats，而是建立了一个plotly 可以处理的注解。 我还简化了美学的定义方式。

对于plotly，你可以只修改一些东西，比如标记高亮点，添加一个字幕：

p1 <- p + theme(legend.position="none")
ggplotly(p1, tooltip = c("x", "y", "z")) %>% 
    config(displayModeBar = F)  %>% 
    layout(title = 'Nice Plot! <br><sub>Point Sizes Vary Based On z</sub>', 
           font=list(color="#a9a9ac")) %>% 
    add_annotations(x=subset(p$data, !is.na(a))$x, 
                    y = subset(p$data, !is.na(a))$y,
                    text = subset(p$data, !is.na(a))$a,
                    xref = "x",
                    yref = "y",
                    showarrow = TRUE,
                    arrowhead = 4,
                    arrowsize = .5)

结果：