在 DT 中为单列渲染下拉列表

Question

我不精通 Javascript，想复制rhandsontable包中可用的下拉功能，但用于DT包。

如何以最有效的方式实现这一目标？

例子

---

library(DT)

i <- 1:5

datatable(iris[1:20, ],
          editable = T,
          options = list(
                    columnDefs = list(
                                      list(
                                           targets = 5,
                                           render = JS(
                     # can't get my head around what should be in the renderer...
         )
      ))
    ))

目标是让i变量充当允许输入的验证器DT对象中。

任何帮助深表感谢！

Answer 1

I blatantly stole the idea from Yihui's app for including radioButtons in DT.

Code:

library(shiny)
library(DT)

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

server <- function(input, output, session) {
  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)]]))
  })
}

shinyApp(ui, server)

Output: