在R语言Plotly平行坐标图中获取选中数据以更新表格

以下是针对你遇到的三个问题的完整解决方案，直接替换原代码即可运行：

library("shiny")
library("plotly")
library("DT")

ui <- fluidPage(
  headerPanel("Example"),
  mainPanel(
    plotlyOutput("plot"),
    verbatimTextOutput("text"),
    DTOutput("table")
  )
)

server <- function(input, output, session) {
  
  df <- reactive({read.csv("https://raw.githubusercontent.com/bcdunbar/datasets/master/iris.csv")})
  
  # 初始化反应式状态，保存所有维度的约束范围，对应初始图表设置
  current_constraints <- reactiveVal(list(
    "Sepal Width" = NULL,
    "Sepal Length" = c(5,6),
    "Petal Width" = NULL,
    "Petal Length" = NULL
  ))
  
  output$plot <- renderPlotly({
    fig <- plot_ly(
      data = df(),
      source = "myplot",
      type = "parcoords",
      line = list(color = ~species_id,
                  colorscale = list(c(0, "red"), c(0.5, "green"), c(1, "blue"))),
      dimensions = list(
        list(
          range = c(2,4.5),
          label = "Sepal Width", 
          values = ~sepal_width,
          constraintrange = current_constraints()[["Sepal Width"]]
        ),
        list(
          range = c(4,8),
          constraintrange = current_constraints()[["Sepal Length"]],
          label = "Sepal Length", 
          values = ~sepal_length
        ),
        list(
          range = c(0,2.5),
          label = "Petal Width", 
          values = ~petal_width,
          constraintrange = current_constraints()[["Petal Width"]]
        ),
        list(range = c(1,7),
             label = "Petal Length", 
             values = ~petal_length,
             constraintrange = current_constraints()[["Petal Length"]]
        )
      )
    )
    
    fig <- event_register(fig, "plotly_restyle")
  })
  
  # 处理交互事件，更新约束状态
  observeEvent(event_data("plotly_restyle", source = "myplot", session = session), {
    new_data <- event_data("plotly_restyle", source = "myplot", session = session)
    
    if (is.null(new_data)) {
      # 双击重置所有约束为初始状态
      current_constraints(list(
        "Sepal Width" = NULL,
        "Sepal Length" = c(5,6),
        "Petal Width" = NULL,
        "Petal Length" = NULL
      ))
    } else {
      # 从现有状态复制，只更新修改过的维度
      updated_constraints <- current_constraints()
      
      # 遍历返回的维度修改信息，更新对应约束
      for (i in seq_along(new_data$dimensions)) {
        dim_info <- new_data$dimensions[[i]]
        if (!is.null(dim_info$label) && !is.null(dim_info$constraintrange)) {
          updated_constraints[[dim_info$label]] <- dim_info$constraintrange
        }
      }
      
      # 如果是调整轴顺序，同步更新约束的顺序（保证和图表轴顺序一致）
      if (!is.null(new_data$dimensions) && all(sapply(new_data$dimensions, function(x) !is.null(x$label)))) {
        new_order <- sapply(new_data$dimensions, function(x) x$label)
        updated_constraints <- updated_constraints[new_order]
      }
      
      current_constraints(updated_constraints)
    }
  })
  
  output$text <- renderPrint({
    current_constraints()
  })
  
  # 根据约束过滤数据
  filtered_df <- reactive({
    constraints <- current_constraints()
    data <- df()
    
    # 逐个维度应用约束过滤
    for (dim_name in names(constraints)) {
      range_val <- constraints[[dim_name]]
      if (!is.null(range_val)) {
        # 把维度标签转为数据框列名格式
        col_name <- tolower(gsub(" ", "_", dim_name))
        data <- data[data[[col_name]] >= range_val[1] & data[[col_name]] <= range_val[2], ]
      }
    }
    
    data
  })
  
  output$table <- renderDT({
    datatable(filtered_df())
  })
  
}

shinyApp(ui,server)

关键解决思路 #

• 维护完整约束状态：用reactiveVal存储所有维度的约束范围，每次交互只更新修改过的维度，避免其他维度被NULL覆盖。
• 双击重置处理：判断event_data返回NULL时，直接将约束状态重置为初始值，实现图表和表格的同步重置。
• 全操作覆盖完整信息：不管是拖动约束还是调整轴顺序，都基于current_constraints维护完整的约束集合，确保任何操作后都能拿到所有维度的当前状态。
• 动态过滤数据：基于约束状态实时过滤原始数据，自动更新DT表格内容。

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