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

Question

I would like to obtain the row number and choice selected each time an input is changed in one of the selectInput. The following is a test code. So in short if I change the species in row three, using observeEvent I would like the output to tell me what row was it in and what was picked.

Is there a way of doing this.

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)

question from:https://stackoverflow.com/questions/65835147/how-to-observeevent-for-selectinput-present-in-each-row-in-a-column

Answer 1

First, you have to use these options preDrawCallback and drawCallback, otherwise Shiny is not aware of the selectors:

  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()); }"
      )
    )
  )

Now, you can use two reactive values to store the row and the species:

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

And then, define an observer for each row:

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

Full app:

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)