R Shiny selectedInput inside renderDataTable cells

Question

I search for solution to put selectedInputs in renderDataTable cells. I found js solutions: https://datatables.net/examples/api/form.html , however I do not know how to implement this solution in shinyjs as renderDataTable object. I would be grateful for hints / ideas / solutions how to implement editable renderDataTable in shiny.

Asleyaslope

Answer 1

Very similar to this: adding a column with TRUE/FALSE and showing that as a checkbox

library(shiny)
library(DT) 
runApp(list(
  ui = basicPage(
    h2('The mtcars data'),
    DT::dataTableOutput('mytable'),
    h2("Selected"),
    tableOutput("checked")
  ),

  server = function(input, output) {
    # helper function for making checkbox
    shinyInput = function(FUN, len, id, ...) { 
      inputs = character(len) 
      for (i in seq_len(len)) { 
        inputs[i] = as.character(FUN(paste0(id, i), label = NULL, ...)) 
      } 
      inputs 
    } 
    # datatable with checkbox
    output$mytable = DT::renderDataTable({
      data.frame(mtcars,Rating=shinyInput(selectInput,nrow(mtcars),"selecter_",
                                            choices=1:5, width="60px"))
    }, selection='none',server = FALSE, escape = FALSE, options = list( 
      paging=TRUE,
      preDrawCallback = JS('function() { 
Shiny.unbindAll(this.api().table().node()); }'), 
      drawCallback = JS('function() { 
Shiny.bindAll(this.api().table().node()); } ') 
    ) )
    # helper function for reading checkbox
    shinyValue = function(id, len) { 
      unlist(lapply(seq_len(len), function(i) { 
        value = input[[paste0(id, i)]] 
        if (is.null(value)) NA else value 
      })) 
    } 
    # output read checkboxes
    output$checked <- renderTable({
      data.frame(selected=shinyValue("selecter_",nrow(mtcars)))
    })
  }
))

Note that if you rerender the table, the inputs won't work unless you add some extra code to unbind.

edit:

Let's say the data in the table is reactive so it changes, and the table rerenders. You will need to explicitely unbind as per @yihui here: https://groups.google.com/forum/#!msg/shiny-discuss/ZUMBGGl1sss/zfcG9c6MBAAJ

So you need to add in the UI:

tags$script(HTML("Shiny.addCustomMessageHandler('unbind-DT', function(id) {
          Shiny.unbindAll($('#'+id).find('table').DataTable().table().node());
        })"))

And then in the Server you trigger the function whenever you rerender the datatable with:

session$sendCustomMessage('unbind-DT', 'mytable')

The colnames parameter is a vector of column names so when you specify a length one vector of FALSE it gives you a table with one column named FALSE. I am not sure of a straightforward way of removing column names from datatables. That would be a good SO question on its own.

Stepheniestephens

Your solution select row when I am choosing selectInput value. Can I disable row selection while choosing selectInput value? – Asleyaslope

Is it possible to update all selected inputs in table if value in first row changes? – Asleyaslope

And if I want to display data.table without column names (colnames = FALSE) it doesn't show at all if it has buttons. What is the reason for that? – Asleyaslope

could you explain what 'add some extra code to unbind' mean? – Asleyaslope

1st question: I don't understand what you mean. Please edit your main question or open a new question. The second thing with colnames seems like a bug, and I will report on github. I will edit my answer to explain the third thing. – Stepheniestephens

Actually the second thing is not a bug and I will explain in the edit – Stepheniestephens

Read ?DT::datatable and see what colnames does – Stepheniestephens

Could you apply your solution of rerender Table to example posted in another question: #40156584 ? – Asleyaslope

I want to add that I was using rmarkdown to achieve the same functionality but for a dropdown menu (i.e. selectInput). The server=FALSE statement caused an unused argument (server = FALSE) error. And unbinding (using preDrawCallback) then binding (using the drawCallback) the choices list didn't make a difference. The most important thing is setting the table to NOT escape the HTML entities (escape=FALSE). Why do you guys think that the unbinding then binding didn't matter? I am not sure how does that work in the rmarkdown context. – Mealy

@Stepheniestephens when i add the session$sendCustomMessage all my tables go blank. Where exactly do I place this if my table re-renders whenever someone clicks on sidebarmenu in shinydashboard – Selfimprovement

Answer 2

Why not use standart fucntional of DT (Shiny.bindAll)

Example( in console print select of 1-st row)

library(shiny)
library(DT)
mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)
runApp(
  list(ui = fluidPage(

      DT::dataTableOutput("mytable")
    )

  , server = function(input, output, session) {

    observe({
      print(input$row1)
    })

    output$mytable = DT::renderDataTable({
      #Display table with select
      DT::datatable(cbind(Pick=paste0('
                                      <select id="row', mymtcars$id, '"> <option>1</option>
                                      <option>2</option></select>',""), mymtcars),
                    options = list(orderClasses = TRUE,
                                   lengthMenu = c(5, 25, 50),
                                   pageLength = 25 ,

                                   drawCallback= JS(
                                     'function(settings) {
                                     Shiny.bindAll(this.api().table().node());}')
                                   ),selection='none',escape=F)


    } )

  })
)

Huckleberry

Answer 3

I have provided a solution here: https://mcmap.net/q/832141/-embedded-selectinput-in-dt-r-shiny-with-large-table. Alternatively, here is a simple solution:

buildOptionalDropdowns <- function(id, choices, selected){
  if(length(choices) > 1)
    return(selectInput(inputId = id, label = NULL, choices = choices, selected = selected))
  else
    return(choices)
  } 

res <- data.frame(a = c(rep(0,5), rep(1,5)),
                  b = character(10)) # adds an empty column
for (i in seq_along(res)) {
   res$b[i] <- as.character(buildOptionalDropdowns(paste0("row_select_", i), 
                                                   choices,
                                                   res$b[[i]]))
}
resultTable <- DT::datatable(res,
                             escape = FALSE)

Even if the question was posted years ago, it maybe still helps someone.

Icy