如何观察列中每一行中存在的 selectInput 事件

Question

我想获取每次在其中一个 selectInput 中更改输入时选择的行号和选择。下面是一段测试代码。所以简而言之，如果我使用 observeEvent 更改第三行中的物种，我希望输出告诉我它在哪一行以及选择了什么。

有没有办法做到这一点。

library(shiny)
library(DT)

ui <- fluidPage(
  DT::dataTableOutput('foo'),
  textOutput("text")
)

server <- function(input, output, session) {
  
  data <- head(iris, 5)
  
  for (i in 1:nrow(data)) {
    data$species_selector[i] <- as.character(selectInput(paste0("change", i), label = paste0("change", 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))
  
  
  observeEvent$...
    
}
  

shinyApp(ui, server)

Answer 1

首先，你必须使用这些选项 preDrawCallback 和 drawCallback，否则 Shiny 不知道选择器：

  output[["foo"]] <- renderDT(
    data, escape = FALSE, selection = 'none', server = FALSE,
    options = list(
      dom = 't', 
      paging = FALSE, 
      ordering = FALSE,
      preDrawCallback = JS(
        "function() { Shiny.unbindAll(this.api().table().node()); }"
      ),
      drawCallback = JS(
        "function() { Shiny.bindAll(this.api().table().node()); }"
      )
    )
  )

现在，您可以使用两个反应值来存储行和种类：

  row <- reactiveVal()
  species <- reactiveVal()

然后，为每一行定义一个观察者：

  lapply(1:nrow(data), function(i){
    selector <- paste0("change", i)
    observeEvent(input[[selector]], {
      row(i)
      species(input[[selector]])
    })
  })

完整应用：

library(shiny)
library(DT)

ui <- fluidPage(
  br(),
  DTOutput('foo'),
  br(),
  wellPanel(
    textOutput("text")
  )
)

server <- function(input, output, session) {
  
  data <- head(iris, 5)
  data$species_selector <- vapply(1:nrow(data), function(i){
    as.character(selectInput(
      paste0("change", i), 
      label = paste0("change", i), 
      choices = unique(iris$Species), 
      width = "100px"
    ))    
  }, character(1))

  output[["foo"]] <- renderDT(
    data, escape = FALSE, selection = 'none', server = FALSE,
    options = list(
      dom = 't', 
      paging = FALSE, 
      ordering = FALSE,
      preDrawCallback = JS(
        "function() { Shiny.unbindAll(this.api().table().node()); }"
      ),
      drawCallback = JS(
        "function() { Shiny.bindAll(this.api().table().node()); }"
      )
    )
  )
  
  row <- reactiveVal()
  species <- reactiveVal()
  
  lapply(1:nrow(data), function(i){
    selector <- paste0("change", i)
    observeEvent(input[[selector]], {
      row(i)
      species(input[[selector]])
    })
  })
  
  output[["text"]] <- renderText({
    sprintf("Row %d --- Species %s", row(), species())
  })
  
}


shinyApp(ui, server)

如何观察列中每一行中存在的 selectInput 事件

How to observeEvent for selectInput present in each row in a column

r

shiny

dt