如何在传递给 JavaScript 之前验证和清理 Shiny 应用程序中的单元格范围？

Question

我目前正在开发一个 Shiny 应用程序，我希望有一个输入来选择 Rhandsontable 的部分。我的目标是在 Shiny 应用程序中对单元格范围进行验证和清理，然后将清理后的单元格范围传递给 JavaScript 进行选择。

这是我迄今为止的代码（基于此post）：

library(shiny)
library(htmlwidgets)
library(rhandsontable)

js <- "
function(el, x) {
  let hot = this.hot;
  Shiny.addCustomMessageHandler('handler_cell_range', function(message) {
    console.log(message);
    hot.selectCells([message]);
  });
}
"

ui <- fluidPage(
  textInput('cell_range', label = 'Cell range (start_row, start_col, end_col, end_row)',
            value = '1,2,3,4', width = '500px'),
  actionButton('bttn_cell_range', label = '', icon = icon('search')),
  rHandsontableOutput('table_raw')
)

server <- function(input, output, session) {
  # Render table
  output$table_raw <- renderRHandsontable({
    rhandsontable(iris) %>% onRender(js)
  })
  
  # Select range
  observeEvent(input$bttn_cell_range, {
    # Here there will be a lot of validation and cleaning of the cell range
    # before it can be passed to js
    
    # Clean cell range
    cr <- input$cell_range
    cr <- gsub(' ', '', cr) # Remove white space
    cr <- strsplit(cr, ',')[[1]] # Split by ,
    cr <- as.numeric(cr) - 1
    
    # Send to javascript to make the selection on the rhandsontable
    session$sendCustomMessage('handler_cell_range', message = cr)
  })
}

shinyApp(ui = ui, server = server)

我想知道这是否是正确的方法。

Answer 1

您的代码很有意义。下面我展示了如何使用 shinyvalidate 包来解决这个问题。当给定的单元格范围无效时，这允许在文本输入附近显示一条消息 (

Invalid cell range

)。

我正在使用正则表达式 (

^\\d+,\\d+,\\d+,\\d+$

) 来测试删除空格后单元格范围是否具有

number,number,number,number

形式。它似乎有效，但我不是正则表达式大师。

library(shiny)
library(shinyvalidate)

ui <- fluidPage(
  br(),
  textInput("cell_range", "Enter cell range"),
  actionButton('bttn_cell_range', label = '', icon = icon('search'))
)

server <- function(input, output, session) {
  
  iv <- InputValidator$new()
  iv$add_rule(
    "cell_range",
    rule = function(cellRange) {
      test <- grepl("^\\d+,\\d+,\\d+,\\d+$", gsub(" ", "", cellRange))
      if(test) {
        return(NULL)
      } else {
        return("Invalid cell range")
      }
    }
  )
  iv$enable()
  
  observeEvent(input$bttn_cell_range, {
    
    req(iv$is_valid())
    
    # Clean cell range
    cr <- input$cell_range
    cr <- gsub(' ', '', cr) # Remove white space
    cr <- strsplit(cr, ',')[[1]] # Split by ,
    cr <- as.numeric(cr) - 1
    
    # Send to javascript to make the selection on the rhandsontable
    session$sendCustomMessage('handler_cell_range', message = cr)
  })
  
}

shinyApp(ui, server)