SelectInput for Every Row of the table in Shiny - r

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(
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(
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.