0

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)

Stéphane Laurent
  • 75,186
  • 15
  • 119
  • 225

1 Answers1

0

Your custom message handler is not correct. It should be

  tags$head(tags$script(
    HTML(
      "Shiny.addCustomMessageHandler('unbindDT', function(id) {
        var $table = $('#'+id).find('table');
        if($table.length > 0){
          Shiny.unbindAll($table.DataTable().table().node());
        }
      })")
  )),

Edit: small example

library(shiny)
library(DT)

tableUI <- function(id) {
  ns <- NS(id)
  tagList(
    actionButton(ns("changeData"), "Change data"),
    br(), br(),
    DTOutput(ns("dtable")),
    verbatimTextOutput(ns("A"))
  )
}

tableServer <- function(id) {
  moduleServer(
    id, 
    function(input, output, session) {
      ns <- session$ns
      Data <- reactiveVal({
        dat <- iris[1:5, 1:5]
        dat$Z <- sapply(LETTERS[1:5], function(idd) as.character(selectInput(
          inputId = ns(idd), 
          label = NULL, 
          choices = c("a", "b", "c"),
          selectize = FALSE
        )))
        dat
      })
      
      Mtcars <- reactiveVal({
        dat <- mtcars[1:5, 1:5]
        dat$Z <- sapply(LETTERS[1:5], function(idd) as.character(selectInput(
          inputId = ns(idd), 
          label = NULL, 
          choices = c("a", "b", "c"),
          selectize = FALSE
        )))
        dat
      })
      
      output[["dtable"]] <- renderDT({
        datatable(
          isolate(Data()),
          escape = FALSE,
          options = list(
            preDrawCallback = 
              JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
            drawCallback = 
              JS('function() { Shiny.bindAll(this.api().table().node()); } ')
          )
        )
      })
      
      output[["A"]] <- renderPrint({
        input[["A"]]
      })
      
      
      
      proxy <- dataTableProxy("dtable")
      
      observeEvent(input$changeData, {
        session$sendCustomMessage("unbindDT", ns("dtable"))
        replaceData(proxy, Mtcars())
      })
      
    }
  )
}


ui <- basicPage(
  tags$head(tags$script(
    HTML(
      "Shiny.addCustomMessageHandler('unbindDT', function(id) {
        var $table = $('#'+id).find('table');
        if($table.length > 0){
          Shiny.unbindAll($table.DataTable().table().node());
        }
      })")
  )),
  br(),
  tableUI("myapp")
)

server <- function(input, output, session) {
  tableServer("myapp")
}

shinyApp(ui, server)
Stéphane Laurent
  • 75,186
  • 15
  • 119
  • 225