SelectInput for Every Row of the table in Shiny

Question

I have a table that has three columns and variable number of rows. I want to create a column such that every row of the new column contains a selectInput with a value of Yes/No.

In a nut shell , how do i automatically generate selectInput equal to the number of rows in my table

Here is a simple code:

library(shiny)
library(rhandsontable)

ui <- fluidPage(

  tableOutput('Simpletable')

)

server <- function(input,output,session)({

  data <- data.frame(c1=c(5,10,15), c2=c(3,6,9) , diff=c(0,0,0), select= as.logical( c(FALSE,FALSE,FALSE)))


  output$Simpletable <- renderTable(
    data
  )

}) 

shinyApp(ui = ui, server = server) 

for this table, three selectInputs should appear alongside the table

Is this possible ?

Thanks

Answer 1

Here is a solution using library(DT) - we need to set escape = FALSE:

library(shiny)
library(DT)
library(data.table)

myTable <- data.table(c1=c(5,10,15), c2=c(3,6,9) , diff=c(0,0,0))
myTable[, row_id := paste0("row_select_", .I)][, select := as.character(selectInput(inputId=row_id, label=NULL, choices=c(yes=TRUE, no=FALSE))), by = row_id]

ui <- fluidPage(
  # please see: https://github.com/rstudio/shiny/issues/3979#issuecomment-1920046008
  # alternative: set selectize = FALSE in selectInput
  htmltools::findDependencies(selectizeInput("dummy", label = NULL, choices = NULL)),
  dataTableOutput('myTableOutput'),
  htmlOutput("mySelection")
)

server <- function(input, output, session){
  output$myTableOutput <- DT::renderDataTable({
    datatable(myTable, escape = FALSE, options = list(
      preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
      drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); }')
    ))
  })
  
  output$mySelection <- renderUI({
    HTML(paste0(myTable$row_id, ": ", lapply(myTable$row_id, function(x){input[[x]]}), collapse = "<br>"))
  })
} 

shinyApp(ui = ui, server = server) 

If you need to re-render the table (when using Shiny.bindAll) please see this related post.

---

Edit: Here is how to incorporate the user inputs in the table as requested by @Fahadakbar.

library(shiny)
library(DT)
library(data.table)

myTable <- data.table(c1=c(5,10,15), c2=c(3,6,9) , diff=c(0,0,0))
myTable[, row_id := paste0("row_select_", .I)][, select := as.character(selectInput(inputId=row_id, label=NULL, choices=c(yes=TRUE, no=FALSE))), by = row_id][, diff := c1-c2]

ui <- fluidPage(
  # please see: https://github.com/rstudio/shiny/issues/3979#issuecomment-1920046008
  # alternative: set selectize = FALSE in selectInput
  htmltools::findDependencies(selectizeInput("dummy", label = NULL, choices = NULL)),
  dataTableOutput('myTableOutput'),
  htmlOutput("mySelection")
)

server <- function(input, output, session){
  output$myTableOutput <- DT::renderDataTable({
    datatable(myTable, escape = FALSE, options = list(
      preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
      drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); }')
    ))
  })
  
  output$mySelection <- renderUI({
    HTML(paste0(myTable$row_id, ": ", lapply(myTable$row_id, function(x){input[[x]]}), collapse = "<br>"))
  })
  
  myReactiveTable <- reactive({
    myTable[, selected := as.logical(unlist(lapply(row_id, function(x){input[[x]]})))]
    
    if(is.null(myTable$selected)){
      myTable[, diff := NA_real_][, selected := NULL]
    } else {
      myTable[, diff := fifelse(selected, yes = c1-c2, no = NA_real_)][, select := as.character(selectInput(inputId=row_id, label=NULL, choices=c(yes=TRUE, no=FALSE), selected = input[[row_id]])), by = row_id][, selected := NULL]
    }
  })
  
  myTableProxy <- dataTableProxy("myTableOutput", session)
  
  observeEvent(myReactiveTable(), {
    replaceData(myTableProxy, data = myReactiveTable(), resetPaging = FALSE)
  })
  
} 

shinyApp(ui = ui, server = server)

Also see my related answer here.