DT 内部模块中闪亮的 selectInput

Question

我正在尝试在模块内的 DT::datatable 内使用 Shiny 输入。不幸的是，我不知道 JavaScript，所以我正在努力处理 DT::renderDataTable 中的回调函数。使用概述的方法 which follows Yihui's app the callback fails when the datatable is rendered inside the module. After some searching I found 回调需要针对命名空间进行调整，但由于此处的默认回调不按名称引用任何输入，我不确定 where/how 是否要对其进行调整。请参阅下面的可重现示例：

library(shiny)
library(DT)

module_ui = function(id, label) {

  ns = NS(id)

  tagList(
    DT::dataTableOutput(ns('foo')),
    verbatimTextOutput(ns('sel'))
  )

}

module_server = function(input, output, session){

  ns = session$ns

  data <- head(iris, 5)

  for (i in 1:nrow(data)) {
    data$species_selector[i] <- as.character(selectInput(paste0("sel", i), "", choices = unique(iris$Species), width = "100px"))
  }

  output$foo = DT::renderDataTable(
    data, escape = FALSE, selection = 'none', server = FALSE,
    options = list(dom = 't', paging = FALSE, ordering = FALSE),
    callback = JS("table.rows().every(function(i, tab, row) {
        var $this = $(this.node());
        $this.attr('id', this.data()[0]);
        $this.addClass('shiny-input-container');
      });
      Shiny.unbindAll(table.table().node());
      Shiny.bindAll(table.table().node());")
  )
  output$sel = renderPrint({
    str(sapply(1:nrow(data), function(i) input[[paste0("sel", i)]]))
  })
}

ui <- fluidPage(
  title = 'Selectinput column in a table',
  h3("Source:", tags$a("Yihui Xie", href = "https://yihui.shinyapps.io/DT-radio/")),
  module_ui("tabl")
)

server <- function(input, output, session) {
  callModule(module_server, "tabl")
}

shinyApp(ui, server)

如有任何帮助，我们将不胜感激！

Answer 1

从那以后，我在我的代码中发现了一个错误：当在上面分配输入时，需要像往常一样在模块中分配输入时将命名空间包裹在它们的 ID 周围：session$ns(paste0("sel", i))。以为我最初是这样做的，但显然不是。无论如何，下面的工作解决方案可能会有所帮助。

library(shiny)
library(DT)

module_ui = function(id, label) {

  ns = NS(id)

  tagList(
    DT::dataTableOutput(ns('foo')),
    verbatimTextOutput(ns('sel'))
  )

}

module_server = function(input, output, session){

  ns = session$ns

  data <- head(iris, 5)

  for (i in 1:nrow(data)) {
    data$species_selector[i] <- as.character(selectInput(ns(paste0("sel", i)), "", choices = unique(iris$Species), width = "100px"))
  }

  output$foo = DT::renderDataTable(
    data, escape = FALSE, selection = 'none', server = FALSE,
    options = list(dom = 't', paging = FALSE, ordering = FALSE),
    callback = JS("table.rows().every(function(i, tab, row) {
        var $this = $(this.node());
        $this.attr('id', this.data()[0]);
        $this.addClass('shiny-input-container');
      });
      Shiny.unbindAll(table.table().node());
      Shiny.bindAll(table.table().node());")
  )

  output$sel = renderPrint({
    str(sapply(1:nrow(data), function(i) input[[paste0("sel", i)]]))
  })
}

ui <- fluidPage(
  title = 'Selectinput column in a table',
  h3("Source:", tags$a("Yihui Xie", href = "https://yihui.shinyapps.io/DT-radio/")),
  module_ui("tabl")
)

server <- function(input, output, session) {
  callModule(module_server, "tabl")
}

shinyApp(ui, server)

DT 内部模块中闪亮的 selectInput

Shiny selectInput in DT inside module

javascript

r

callback

shiny

dt