如何在生成新数据集时重置rhandsontable中的选中单元格范围？

在以下示例中，每次生成新数据集时，如何重置rhandsontable中选中的单元格范围？

library(shiny)
library(data.table)
library(rhandsontable)

shinyApp(
  ui = fluidPage(
    actionButton('gendata', 'Generate data'),
    hr(),
    verbatimTextOutput('verb'),
    hr(),
    rHandsontableOutput('table_original'),
    hr(),
    rHandsontableOutput('table_subset')
  ),
  
  server = function(input, output, session) {
    mydata <- reactive({
      req(input$gendata)
      n_dim <- sample(2:8, 1)
      data.table( matrix(rnorm(n_dim**2), n_dim, n_dim) )
    })
    output$table_original <- renderRHandsontable({
      req(mydata())
      rhandsontable(data = mydata(), selectCallback = TRUE)
    })
    output$table_subset <- renderRHandsontable({
      req(input$table_original_select$select)
      selected_rows <- input$table_original_select$select$rAll
      selected_cols <- input$table_original_select$select$cAll
      DT <- hot_to_r(input$table_original)
      DT <- DT[selected_rows, ..selected_cols] # subset
      rhandsontable(DT)
    })
    output$verb <- renderPrint({
      str(input$table_original_select$select)
    })
  }
)

编辑1 #

我考虑用JavaScript解决，但对这门语言不熟悉，没法自己实现。

编辑2 #

我已经解决了生成新数据集时，若之前选中的范围大于当前数据集会报错的问题，但希望有更优方案：

library(shiny)
library(data.table)
library(rhandsontable)

shinyApp(
  ui = fluidPage(
    actionButton('gendata', 'Generate data'),
    hr(),
    verbatimTextOutput('verb'),
    hr(),
    rHandsontableOutput('table_original'),
    hr(),
    rHandsontableOutput('table_subset')
  ),
  
  server = function(input, output, session) {
    
    first_range_selection <<- TRUE
    
    mydata <- reactive({
      req(input$gendata)
      n_dim <- sample(2:8, 1)
      data.table( matrix(rnorm(n_dim**2), n_dim, n_dim) )
    })
    
    observeEvent(mydata(), {
      if (first_range_selection) {
        reset_range <<- FALSE
        first_range_selection <<- FALSE
      } else {
        reset_range <<- TRUE
      }
    })
    
    output$table_original <- renderRHandsontable({
      req(mydata())
      rhandsontable(data = mydata(), selectCallback = TRUE)
    })
    output$table_subset <- renderRHandsontable({
      req(input$table_original_select$select)
      if (reset_range) {
        reset_range <<- FALSE
        return()
      }
      selected_rows <- input$table_original_select$select$rAll
      selected_cols <- input$table_original_select$select$cAll
      DT <- hot_to_r(input$table_original)
      DT <- DT[selected_rows, ..selected_cols] # subset
      rhandsontable(DT)
    })
    output$verb <- renderPrint({
      str(input$table_original_select$select)
    })
  }
)

最优解决方案 #

要真正重置rhandsontable的选中单元格范围，可通过JavaScript回调结合Shiny的消息机制实现，同时优化范围校验逻辑，替代全局变量的方式。完整代码如下：

library(shiny)
library(data.table)
library(rhandsontable)

shinyApp(
  ui = fluidPage(
    actionButton('gendata', 'Generate data'),
    hr(),
    verbatimTextOutput('verb'),
    hr(),
    rHandsontableOutput('table_original'),
    hr(),
    rHandsontableOutput('table_subset'),
    # 注册自定义JavaScript消息处理器
    tags$script(HTML("
      Shiny.addCustomMessageHandler('resetHotSelection', function() {
        var hotInstance = HTMLWidgets.getInstance(document.getElementById('table_original')).hot;
        hotInstance.deselectCell(); // 清除选中的单元格
        hotInstance.clearSelection(); // 清除选中范围
      });
    "))
  ),
  
  server = function(input, output, session) {
    mydata <- reactive({
      req(input$gendata)
      n_dim <- sample(2:8, 1)
      data.table( matrix(rnorm(n_dim**2), n_dim, n_dim) )
    })
    
    # 数据集更新时触发选中范围重置
    observeEvent(mydata(), {
      session$sendCustomMessage("resetHotSelection", list())
    })
    
    output$table_original <- renderRHandsontable({
      req(mydata())
      rhandsontable(data = mydata(), selectCallback = TRUE)
    })
    
    output$table_subset <- renderRHandsontable({
      req(input$table_original_select$select)
      selected_rows <- input$table_original_select$select$rAll
      selected_cols <- input$table_original_select$select$cAll
      
      # 校验选中范围，确保不超出当前数据集行列数
      selected_rows <- intersect(selected_rows, seq_len(nrow(mydata())))
      selected_cols <- intersect(selected_cols, seq_len(ncol(mydata())))
      
      if(length(selected_rows) == 0 || length(selected_cols) == 0){
        return(NULL)
      }
      
      DT <- hot_to_r(input$table_original)
      DT <- DT[selected_rows, ..selected_cols]
      rhandsontable(DT)
    })
    
    output$verb <- renderPrint({
      str(input$table_original_select$select)
    })
  }
)

方案说明 #

1. 前端交互逻辑：通过Shiny.addCustomMessageHandler注册消息处理器，收到重置指令时，获取rhandsontable实例并调用内置方法清除选中状态，实现界面上的选中范围重置。
2. 后端触发机制：在数据集更新时，通过session$sendCustomMessage向前端发送重置信号，确保每次生成新数据后自动执行清除操作。
3. 范围校验优化：用intersect方法直接过滤选中行/列，确保不超出当前数据集范围，避免报错的同时，比全局变量方案更简洁可靠。

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