Shiny

Question

在下面的示例中，我有 3 个 DT::datatables。我希望用户能够从所有这些 table 中 select 不超过一行。因此，根据 documentation 中的 "Manipulate An Existing DataTables Instance" 部分，我使用 dataTableProxy 和 selectRow。效果很好。

但是，在我的应用程序中，我有 24 个（将该值称为 N）table。如果我尝试将下面的代码改编为我的 24 tables 页面，我会得到数量惊人的代码行。

这样做更聪明的方法是什么？

特别是，我怎样才能：

动态声明观察者？（用户5029763回答）
知道最后点击了哪个 table（不是行）吗？（即如何重写reactiveText()？）

编辑： 我在下面的代码中复制了 user5029763 的答案（见下文）。

DTWrapper <- function(data, pl = 5, preselec = c()){
  datatable(data,
            options = list(pageLength = pl, dom='t',ordering=F),
            selection = list(mode = 'single', selected= preselec),
            rownames = FALSE)
}
resetRows <- function(proxies, self){
  for (i in 1:length(proxies)){
    if (self != i){
      proxies[[i]] %>% selectRows(NULL)
    }
  }
}

lapply(1:3, function(id) {
  observe({
    rownum <- input[[paste0("tab",id,"_rows_selected")]]
    if (length(rownum) > 0) { resetRows(proxyList(), id) }
  })
})

server = function(input, output) {

  output$tab1 <- DT::renderDataTable(DTWrapper(head(mtcars[,1:3]), input$selectTop))
  output$tab2 <- DT::renderDataTable(DTWrapper(head(mtcars[,1:3]), input$selectTop))
  output$tab3 <- DT::renderDataTable(DTWrapper(head(mtcars[,1:3]), input$selectTop))

  proxyList <- reactive({
    proxies = list()
    for (i in 1:3){
      tableID <- paste("tab", i, sep="")
      proxies[[i]] = dataTableProxy(tableID)
    }
    return(proxies)
  }) 

  reactiveText <- reactive({
    rownum1 <- input$tab1_rows_selected
    rownum2 <- input$tab2_rows_selected
    rownum3 <- input$tab3_rows_selected
    if (length(rownum1) > 0){return(c(rownum1, 1))}
    if (length(rownum2) > 0){return(c(rownum2, 2))}
    if (length(rownum3) > 0){return(c(rownum3, 3))}
  })

  output$txt1 <- renderText({
    paste("You selected row ", reactiveText()[1]
          , " from table ", reactiveText()[2], ".", sep="")
  })
}

shinyApp(
  ui = fluidPage(
    fluidRow(column(4,DT::dataTableOutput("tab1"))
             , column(4,DT::dataTableOutput("tab2"))
             , column(4, DT::dataTableOutput("tab3")))
    ,fluidRow(column(4,textOutput("txt1")))
  ),
  server = server
)

textOutput是："You selected the Xth row from the Yth table".

Answer 1

编辑后：

你可以试试modules。另一种方法是 lapply.

lapply(1:3, function(id) {
    observe({
      rownum <- input[[paste0("tab",id,"_rows_selected")]]
      if (length(rownum) > 0) {
        resetRows(proxyList(), id)
        
        msg <- paste0("You selected row ", rownum, ", from table ", id, ".")
        output$txt1 <- renderText(msg)
      }
    })
})

Shiny - DT - 单行选择，跨多个 DT::tables

Shiny - DT - Single row selection, across several DT::tables

datatable

r

dt

编辑后：