咱直接上干货，因为Plotly静态图不支持拖拽交互，结合Shiny就能搞定你要的所有需求——可拖拽的水平/竖直线、实时更新右上象限散点颜色，还能获取线的位置数值用于后续分析。下面是完整可运行的代码：

library(shiny)
library(plotly)
library(dplyr)

# 示例数据，你可以换成自己的数据集
data <- mtcars %>% 
  mutate(id = row_number())

ui <- fluidPage(
  titlePanel("可拖拽横竖线的散点图"),
  sidebarLayout(
    sidebarPanel(
      h4("当前线位置"),
      textOutput("hline_val"),
      textOutput("vline_val")
    ),
    mainPanel(
      plotlyOutput("scatter_plot")
    )
  )
)

server <- function(input, output, session) {
  # 初始化线的位置：用中位数作为初始值
  initial_hline <- median(data$mpg)
  initial_vline <- median(data$wt)
  
  # 用reactiveValues存储当前线的位置，方便动态更新
  line_positions <- reactiveValues(
    hline = initial_hline,
    vline = initial_vline
  )
  
  # 捕捉Plotly的拖拽事件，更新线的位置
  observeEvent(event_data("plotly_relayout"), {
    relayout_data <- event_data("plotly_relayout")
    
    # 更新水平线位置（对应shapes[0]）
    if (!is.null(relayout_data[['shapes[0].y0']])) {
      line_positions$hline <- relayout_data[['shapes[0].y0']]
    }
    
    # 更新竖直线位置（对应shapes[1]）
    if (!is.null(relayout_data[['shapes[1].x0']])) {
      line_positions$vline <- relayout_data[['shapes[1].x0']]
    }
  })
  
  # 动态生成带颜色的数据：右上象限（x>vline, y>hline）设为红色，其他蓝色
  colored_data <- reactive({
    data %>% 
      mutate(
        point_color = case_when(
          wt > line_positions$vline & mpg > line_positions$hline ~ "red",
          TRUE ~ "blue"
        )
      )
  })
  
  # 渲染Plotly散点图
  output$scatter_plot <- renderPlotly({
    plot_ly(colored_data(), x = ~wt, y = ~mpg, color = ~point_color,
            type = "scatter", mode = "markers", showlegend = FALSE) %>%
      # 添加可拖拽的水平线
      add_lines(x = c(0, max(data$wt)), y = c(line_positions$hline, line_positions$hline),
                line = list(color = "black", dash = "dash"),
                editable = list(shapePosition = TRUE),
                name = "水平线") %>%
      # 添加可拖拽的竖直线
      add_lines(x = c(line_positions$vline, line_positions$vline), y = c(0, max(data$mpg)),
                line = list(color = "black", dash = "dash"),
                editable = list(shapePosition = TRUE),
                name = "竖直线") %>%
      layout(xaxis = list(title = "重量(wt)"),
             yaxis = list(title = "油耗(mpg)"))
  })
  
  # 显示当前线的位置数值，方便后续使用
  output$hline_val <- renderText({
    paste0("水平线位置: ", round(line_positions$hline, 2))
  })
  
  output$vline_val <- renderText({
    paste0("竖直线位置: ", round(line_positions$vline, 2))
  })
}

shinyApp(ui, server)

关键功能解释 #

• 可拖拽线的实现：通过editable = list(shapePosition = TRUE)开启线的拖拽功能，再用event_data("plotly_relayout")捕捉拖拽后的位置变化，实时更新reactiveValues里的线坐标。
• 象限散点变色：用reactive动态生成带颜色标记的数据，每次线的位置变化时，自动筛选出右上象限的点并设置不同颜色。
• 获取线位置数值：line_positions$hline和line_positions$vline就是当前两条线的位置数值，你可以直接在server里调用它们做后续分析（比如统计右上象限的点数量、计算均值等）。

注意事项 #

• 如果你的数据集和示例不同，记得替换data对象，以及对应的x轴、y轴变量（比如把wt和mpg换成你自己的列名）。
• 拖拽线时，界面右侧的线位置数值会实时更新，你也可以把这些数值保存到变量里，用于后续的计算或导出。

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