如何在Shiny的Plotly散点图中避免R值与p值标注重叠？

问题说明 #

使用Plotly绘制按物种区分颜色的散点图，同时展示Pearson相关系数R值与p值标注时，在Shiny环境中出现标注文本重叠的问题，无法清晰区分各组的统计结果。

Shiny异常效果 #

各组的R值与p值标注相互堆叠，内容重叠难以辨认。

问题代码示例 #

ui <- fluidPage(
  
  plotlyOutput("plot")
)

server <- function(input, output) {
  
  output$plot <- renderPlotly({
    p <- ggplot(iris, aes(Sepal.Length, Petal.Length)) + list(
      geom_point(aes(color = Species)),
      ggpubr::stat_cor(aes(color = Species), method = "pearson", output.type= "text")
    )
    ggplotly(p) 
  })
  
  
}
shinyApp(ui, server)

预期效果 #

各组的Pearson相关系数标注位置分散，无重叠，可清晰查看每组的R值与p值。

解决方案 #

方法1：手动设置标注偏移量 #

通过stat_cor的position参数，使用position_nudge给不同组的标注设置差异化偏移，避免重叠：

ui <- fluidPage(
  
  plotlyOutput("plot")
)

server <- function(input, output) {
  
  output$plot <- renderPlotly({
    # 为三个物种分别设置x、y方向的偏移量
    nudge_pos <- position_nudge(x = c(0.3, 0, -0.3), y = c(0.5, 0, -0.5))
    
    p <- ggplot(iris, aes(Sepal.Length, Petal.Length)) +
      geom_point(aes(color = Species)) +
      ggpubr::stat_cor(aes(color = Species), 
                       method = "pearson", 
                       output.type= "text",
                       position = nudge_pos)
    
    ggplotly(p) 
  })
}
shinyApp(ui, server)

方法2：用ggrepel自动避免重叠 #

借助ggrepel包的geom_text_repel函数，自动计算不重叠的标注位置，结合stat_cor生成的统计数据实现：

ui <- fluidPage(
  
  plotlyOutput("plot")
)

server <- function(input, output) {
  
  output$plot <- renderPlotly({
    # 先计算各组的相关系数统计数据
    cor_data <- ggpubr::stat_cor(data = iris,
                                 aes(Sepal.Length, Petal.Length, color = Species),
                                 method = "pearson",
                                 output.type = "data.frame")
    
    p <- ggplot(iris, aes(Sepal.Length, Petal.Length)) +
      geom_point(aes(color = Species)) +
      ggrepel::geom_text_repel(data = cor_data,
                               aes(x = x, y = y, label = label, color = group),
                               show.legend = FALSE)
    
    ggplotly(p) 
  })
}
shinyApp(ui, server)

方法3：直接用Plotly原生API绘制标注 #

绕过ggplot转换，直接使用Plotly原生函数控制散点和标注的位置，精准度更高：

ui <- fluidPage(
  
  plotlyOutput("plot")
)

server <- function(input, output) {
  
  output$plot <- renderPlotly({
    # 分组计算Pearson相关系数和p值，同时定义标注位置
    cor_results <- iris %>%
      group_by(Species) %>%
      summarise(
        r = cor(Sepal.Length, Petal.Length, method = "pearson"),
        p = cor.test(Sepal.Length, Petal.Length)$p.value,
        x_pos = max(Sepal.Length),
        y_pos = max(Petal.Length) + 0.3 * cur_group_id() # 按组递增y轴位置
      ) %>%
      mutate(label = paste0("r = ", round(r, 2), "\np = ", format(p, digits = 2)))
    
    # 绘制基础散点图
    fig <- plot_ly(iris, x = ~Sepal.Length, y = ~Petal.Length, color = ~Species, type = "scatter", mode = "markers")
    
    # 逐个添加各组标注
    for(i in 1:nrow(cor_results)){
      fig <- fig %>%
        add_annotations(
          x = cor_results$x_pos[i],
          y = cor_results$y_pos[i],
          text = cor_results$label[i],
          showarrow = FALSE,
          font = list(color = cor_results$Species[i]),
          xanchor = "right"
        )
    }
    
    fig %>% layout(showlegend = TRUE)
  })
}
shinyApp(ui, server)

方案说明 #

• 方法1适合简单场景，手动调整偏移量快速解决问题；
• 方法2适合数据动态变化的场景，自动处理标注位置；
• 方法3控制粒度最细，适配复杂交互需求，完全基于Plotly原生逻辑实现。

内容的提问来源于stack exchange，提问作者01200