在 R Shiny 中的可反应中添加自定义搜索字段

Question

我正在 R Shiny 中开发一个应用程序，它使用 reactable 包显示表格。我正在尝试添加一个自定义搜索字段来搜索表中的所有列。看看Greg Lin 的示例代码，有一个代码非常适合“自定义搜索输入”，但我无法将其改编为 Shiny。这是我的代码：

library(shiny)
library(reactable)
library(htmltools)

ui <- fluidPage(
  
  # Interface elements
  titlePanel("Custom Search in reactable"),
  fluidRow(
    div(
      style = "margin-bottom: 0.75rem",
      tags$input(
        type = "text",
        placeholder = "Search for cars...",
        style = "padding: 0.25rem 0.5rem; width: 100%",
        oninput = "Reactable.setSearch('cars-search-table', this.value)"
      )
    ),
    
    # Show reactable
    div(id = "table-content", reactableOutput("contents"))
  )
)

server <- function(input, output) {
  
  # Render reactable
  output$contents <- renderReactable({
    
    # Load data
    data <- MASS::Cars93[1:15, c("Manufacturer", "Model", "Type", "Price")]
    
    reactable(data,
              defaultPageSize = 5,
              elementId = "cars-search-table")
  })
  
}

shinyApp(ui, server)

我的例子完美运行。它使用 elementId 间接填充具有可反应的搜索字段，但当我运行应用程序时，我收到此警告：

renderWidget(instance) 中的警告：忽略显式提供的 小部件 ID“汽车搜索表”； Shiny 不使用它们

我不知道这是否是最好的选择，但我曾考虑过使用shinyjs在渲染reactable后更改elementId，但我无法让它正常工作：

library(shiny)
library(reactable)
library(htmltools)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),  # Incluir shinyjs en la UI
  
  # Interface elements
  titlePanel("Custom Search in reactable"),
  fluidRow(
    div(
      style = "margin-bottom: 0.75rem",
      tags$input(
        id = "search-input",
        type = "text",
        placeholder = "Search for cars...",
        style = "padding: 0.25rem 0.5rem; width: 100%"
      )
    ),
    
    # Show reactable
    div(id = "table-content", reactableOutput("contents"))
  )
)

server <- function(input, output, session) {
  
  # Render reactable
  output$contents <- renderReactable({
    
    # Load data
    data <- MASS::Cars93[1:15, c("Manufacturer", "Model", "Type", "Price")]
    
    reactable(data,
              defaultPageSize = 5,
              elementId = NULL)  # No usamos elementId aquí
  })
  
  # Modify the table after it has been rendered
  observe({
    runjs("document.querySelector('#table-content > div').id = 'cars-search-table';")
    
    # Connect the search input to the table
    runjs("
      document.getElementById('search-input').oninput = function() {
        Reactable.setSearch('cars-search-table', this.value);
      };
    ")
  })
  
}

shinyApp(ui, server)

更新：根据用户@masgusl的建议，我尝试使用串扰。这是我生成的代码：

library(shiny)
library(reactable)
library(htmltools)
library(crosstalk)

ui <- fluidPage(
  
  # Interface elements
  titlePanel("Custom Search in reactable"),
  fluidRow(
    div(
      style = "margin-bottom: 0.75rem",
      tags$input(
        type = "text",
        id = "search",
        placeholder = "Search for cars...",
        style = "padding: 0.25rem 0.5rem; width: 100%"
      )
    ),
    
    # Show reactable
    div(id = "table-content", reactableOutput("contents"))
  )
)

server <- function(input, output) {
  
  # Load data
  data <- MASS::Cars93[1:15, c("Manufacturer", "Model", "Type", "Price")]
  
  # Create crosstalk shared data object
  shared_data <- SharedData$new(data)
  
  # Create crosstalk filter
  filtered_data <- reactive({
    if (input$search == "") {
      shared_data$data()
    } else {
      shared_data$data() %>%
        filter(if_any(everything(), ~ grepl(input$search, ., ignore.case = TRUE)))
    }
  })
  
  # Render reactable
  output$contents <- renderReactable({
    
    reactable(filtered_data(),
              defaultPageSize = 5
              )
  })
  
}

shinyApp(ui, server)

在这种情况下，代码可以完美运行，但对于非常大的数据集，当您过滤数据时，显示过滤后的数据之前的等待时间非常明显。不知道代码有没有优化。

有人可以帮我找到一个尽可能简单的解决方案吗？也许有更合适的解决方案。

非常感谢。

Answer 1

最后，感谢@Jan 的评论，我查看了另一篇文章，这又引导我找到了有关 Reactable 以及如何使用 javascript API 的文档。本节描述了对于 Shiny 应用程序，elementId 直接从reactableOutput() 中指定的 Shiny 输出 ID 中获取，因此我的示例代码中的问题是通过删除 elementId 并更改 'Reactable.setSearch 中的引用来解决的'。我的代码如下所示：

library(shiny)
library(reactable)
library(htmltools)

ui <- fluidPage(
  
  # Interface elements
  titlePanel("Custom Search in reactable"),
  fluidRow(
    div(
      style = "margin-bottom: 0.75rem",
      tags$input(
        type = "text",
        placeholder = "Search for cars...",
        style = "padding: 0.25rem 0.5rem; width: 100%",
        oninput = "Reactable.setSearch('contents', this.value)"
      )
    ),
    
    # Show reactable
    div(id = "table-content", reactableOutput("contents"))
  )
)

server <- function(input, output) {
  
  # Render reactable
  output$contents <- renderReactable({
    
    # Load data
    data <- MASS::Cars93[1:15, c("Manufacturer", "Model", "Type", "Price")]
    
    reactable(data,
              defaultPageSize = 5)
  })
  
}

shinyApp(ui, server)

知道了这一点，解决方案就非常简单了，不需要使用串扰。至少在这种情况下。

感谢大家的评论。最后，你们都帮助我寻找其他我将来可以使用的替代方案。

再次感谢
沃迪亚姆