从Shiny应用程序的Reactable表中删除所有/无复选框

Question

我希望从闪亮应用程序中使用的可反应表中删除全部/无复选框。 对于常规 R 脚本，建议了一个答案here。

但是这个解决方案失败了：

renderWidget（实例）中的警告： 忽略前置内容； prependContent 不能在 Shiny 渲染调用中使用

下面的代码无法删除带有上述错误的复选框。 那么，如何在 Shiny 应用程序中删除可反应表的全部/无复选框。

library(reactable)
library(htmlwidgets)

javascript <- JS('
document.querySelector(\'.rt-select-input[aria-label="Select all rows"]\').parentElement.parentElement.style.display="none";
')


ui <- fluidPage(reactableOutput("table")
)

server <- function(input, output, session) {
  output$table <- renderReactable({
    e <- reactable(iris,
              onClick = "select",
              selection = "multiple") 
    (p <- prependContent(e, onStaticRenderComplete(javascript)))
    })
}  
shinyApp(ui, server)  

Answer 1

这可以通过使用 shiny 的 javascript 事件和

shinyjs

包来实现。

• js.code

  定义 js 函数，将事件处理程序添加到

  shiny:visualchange

  事件。

• useShinyjs()

  使用shinyjs包。

• extendShinyjs

  定义js函数以便使用。

• js$hideSelectAll("table")

  将事件处理程序添加到表中。

• delay(100, runjs('$( "#table" ).trigger( "shiny:visualchange" );'))

  延迟对事件处理程序的调用，以便刷新表。

注意：

我尝试了

shiny:value

事件，但它不起作用，据说每当渲染输出组件时就应该执行它，但遗憾的是它没有。

library(reactable)
library(shiny)
library(shinyjs)
# you'll need to pass the id that you provided to reactableOutput(id)
js.code <- '
shinyjs.hideSelectAll = function(id){
    $("#"+id).on("shiny:visualchange", function({currentTarget}) {   
        currentTarget = currentTarget.querySelector(".rt-select-input[aria-label=\'Select all rows\']")
        if(currentTarget) currentTarget.parentElement.parentElement.style.display="none";
    });
} 
'

ui <- fluidPage(reactableOutput("table"),
    useShinyjs(debug=TRUE),
    extendShinyjs(text = js.code, functions = c("hideSelectAll"))
)

server <- function(input, output, session) { 
  output$table <- renderReactable({ 
    reactable(iris,
              onClick = "select",
              selection = "multiple")
    })
    js$hideSelectAll("table")
    delay(100, runjs('$( "#table" ).trigger( "shiny:visualchange" );'))
    
    #runjs('$( "#table" ).trigger( "shiny:visualchange" );')
}  
shinyApp(ui, server)  

如果您打算使用一次

library(reactable)
library(shiny)
library(shinyjs)
js.code <- '
document.querySelector(\'.rt-select-input[aria-label="Select all rows"]\').parentElement.parentElement.style.display="none";
'

ui <- fluidPage(reactableOutput("table"),
    useShinyjs(debug=TRUE)
)

server <- function(input, output, session) { 
  output$table <- renderReactable({ 
    reactable(iris,
              onClick = "select",
              selection = "multiple")
    })
    delay(100, runjs(js.code))
    
}  
shinyApp(ui, server) 

仅使用闪亮而不依赖外部：

即使刷新数据也不会显示全选按钮。看来我的第一个代码不是最佳的:(但我将它作为参考。

ui <- fluidPage(reactableOutput("table"),
    actionButton("button", "refresh"),
    tags$head(tags$script(HTML('
            setTimeout(()=>{
                document.querySelector(\'#table .rt-select-input[aria-label="Select all rows"]\').parentElement.parentElement.style.display="none";
            }, 200)
    ')))
)

server <- function(input, output, session) { 
  output$table <- renderReactable({ 
    reactable(iris,
              onClick = "select",
              selection = "multiple")
    })
    observeEvent(input$button, {
    output$table <- renderReactable({ 
    reactable(mtcars,
              onClick = "select",
              selection = "multiple")
        })
    })
}  
shinyApp(ui, server)