I am trying to build a shiny app that uses dynamically created inputs within a data.table with the help of the DT package. In the example below, in module2 server I am getting reactive datatable named "module1_data" from module1 and trying to create column with dropdowns (using "module1_data") for assigning values for each row and saving it in a database table.
But dropdown user input is captured only at the first instance and from the second instance, user input is not captured.
One of solution I found online was I should unbind before rendering the data but was not successfull. It would be helpful if someone can help on this. Thanks in advance. shiny-bound-input class lost in R Shiny with DT and data.table
Below is the example.
module1UI <- function(id) {
#UI section
}
module1 <- function(input, output, session) {
ns <- NS("module1")
#......
return(
list(
module1_data = reactive({rv$data})
)
)
}
##########################
module2UI <- function (id){
tagList(
tags$head(tags$script(
HTML(
"Shiny.addCustomMessageHandler('unbindDT',
table.rows().every(function(i, tab, row) {
var $this = $(this.node());
$this.attr('id', this.data()[0]);
$this.addClass('shiny-input-container');
Shiny.unbindAll(this.api().table().node());
});
)"
)
)),
DT::dataTableOutput(ns('op_data')),
actionButton(ns('save_inputs'), 'Save Inputs')
)
}
module2 <- function(input, output, session, module1_server) {
ns <- NS("module2")
data <- reactive({
data2 <- module1_server$module1_data()
data2$select_val <- ''
for (i in 1:nrow(data2)) {
data2$select_val[i] <- as.character(selectInput(ns(paste0("sel", i)),
"",
choices = c("A","B","C","D"),
width = "100px"))
}
data2
})
output$op_data = DT::renderDT(
{
datatable(
data(),
escape = FALSE, selection = 'none',
options = list(scrollY = 1000, dom = 't', paging = FALSE, ordering = FALSE,
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); }'))
, rownames = FALSE
)
}, server = FALSE)
observeEvent(input$save_inputs, {
session$sendCustomMessage("unbindDT", "op_data")
inputs <- sapply(1:nrow(data()), function(i) input[[paste0("sel", i)]])
# Inputs data.frame
data3 <- cbind(data(),inputs)
#Inserting data into database
sql_res <- tryCatch({
dbExecute(conn,"drop table if exists tbl1")
dbWriteTable(conn,"tbl1",data3)
TRUE
}, error = function(e) {
debugmsg(3,"Error running statement: {e}")
print(e)
return(FALSE)
})
if (sql_res){
shinyalert("Submitted","Submitted sucessfully", type = "success")
}
})
}
ui <- fluidPage(
#....
)
server <- function(input, output, session) {
module1_server <- callModule(module1, "module1")
module2_server <- callModule(module2, "module2", module1_server)
}
# Run the application
shinyApp(ui = ui, server = server)