在R Shiny+Plotly中通过rhandsontable手动调整标注坐标及添加动态箭头

核心实现逻辑 #

• 手动控制标注位置：用rhandsontable提供可编辑的坐标表格，修改后的坐标同步到reactiveVal存储的标注数据，再将这些坐标传入Plotly的annotations参数定位标签。
• 动态箭头：在标注配置中添加箭头属性，把箭头起点绑定到散点原始坐标，终点绑定手动设置的标注坐标，通过复选框控制箭头显示/隐藏。

完整代码实现 #

library(shiny)
library(plotly)
library(rhandsontable)

ui <- fluidPage(
  titlePanel("Plotly散点图：可手动调整的标注与箭头"),
  sidebarLayout(
    sidebarPanel(
      rHandsontableOutput("table"),
      checkboxInput("show_arrows", "显示箭头", value = TRUE)  
    ),
    mainPanel(
      plotlyOutput("scatterplot")
    )
  )
)

server <- function(input, output, session) {
  
  dot_data <- data.frame(
    id = 1:5,
    label = c("A", "B", "C", "D", "E"),
    x_dot = c(1, 2, 3, 4, 5), 
    y_dot = c(2, 3, 4, 5, 6)   
  )
  
  label_data <- reactiveVal(data.frame(
    id = 1:5,
    label = c("A", "B", "C", "D", "E"),
    x_label = c(1.2, 2.2, 3.2, 4.2, 5.2),  # 初始偏移散点，方便区分
    y_label = c(2.3, 3.3, 4.3, 5.3, 6.3)
  ))
  
  output$table <- renderRHandsontable({
    rhandsontable(label_data(), stretchH = "all", height = 300) %>%
      hot_col(c("id", "label"), readOnly = TRUE)  # 固定非编辑列
  })
  
  observeEvent(input$table, {
    new_data <- hot_to_r(input$table)
    # 强制转换坐标列为数值，避免编辑后类型异常
    new_data$x_label <- as.numeric(new_data$x_label)
    new_data$y_label <- as.numeric(new_data$y_label)
    label_data(new_data) 
  })
  
  output$scatterplot <- renderPlotly({
    data <- label_data()
    # 合并散点与标注数据，统一配置箭头
    combined_data <- merge(dot_data, data, by = c("id", "label"))
    
    plot <- plot_ly() %>%
      add_trace(
        data = dot_data,
        x = ~x_dot,
        y = ~y_dot,
        type = "scatter",
        mode = "markers",
        marker = list(size = 10, color = "blue")
      ) 
    
    # 生成标注配置列表
    annotations <- lapply(1:nrow(combined_data), function(i) {
      row <- combined_data[i,]
      list(
        x = row$x_label,
        y = row$y_label,
        text = row$label,
        showarrow = input$show_arrows,
        arrowhead = 2,
        arrowwidth = 1.5,
        ax = row$x_dot - row$x_label,  # 计算箭头起点相对终点的偏移
        ay = row$y_dot - row$y_label
      )
    })
    
    # 添加标注到图表
    plot %>% layout(annotations = annotations)
  })
}

# 运行应用
shinyApp(ui = ui, server = server)

关键细节说明 #

• 锁定id和label列为只读，避免误修改核心标识内容。
• 编辑表格后强制转换坐标列类型，防止输入非数值导致绘图报错。
• 箭头偏移量通过散点与标注坐标的差值计算，确保箭头始终指向对应散点。
• 利用复选框状态控制showarrow参数，实现箭头的动态显隐切换。

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