Search code examples
rshinydatatable

R Shiny DT rendering shinyinputs breaks the width definition


I am trying to render different shinyinputs (in the example below I have checkboxes, but I am also rendering dropdowns) in a datatable on DT with R Shiny, using the shinyInput function below.

It works great, I was able to render all the components that I wanted inside the cells.

Unfortunately now I am trying to make the whole table readable and I am facing this issue.

Without the checkboxes the table is rendered properly and the column width are taken from the coldef, where I have a list of lists containing targets and widths.

As soon as I include checkboxes or any other shiny component, the columndef is not working anymore, not only for the columns containing checkboxes but for ALL of the columns, it just seems that the columndef is not present.

I trying solving my way around and I am not sure if this is a bug or if there even is any workaround for this issue. I spent so much time on this table that I would feel quite bad dropping it just because it's looking so bad with the checkboxes column rendered with 300px width.

In the example below you can keep or drop the variable newvar from the dataframe to see the behaviour changing on the inclusion of checkboxes, even though the first 3 columns aren't changing.

library(DT)

ui <- basicPage(
  h2("The mtcars data"),
  DT::dataTableOutput("mytable")
)

server <- function(input, output) {
  
  shinyInput <- function(FUN, len, id, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }
  
  mtcarsx <- data.frame(mtcars, newvar=paste0(shinyInput(checkboxInput,nrow(mtcars),"mychbx",label="",value=FALSE,width=NULL)))

  colDef <- list(
    list(
      targets=0,
      width="150px"
    ),
    list(
      targets=1,
      width="300px"
    ),
    list(
      targets=2,
      width="500px"
    )
  )

  output$mytable = DT::renderDataTable({
    DT::datatable(mtcarsx, 
                  escape = FALSE, 
                  selection = 'none', 
                  rownames = FALSE, 
                  options = list(searching = FALSE, 
                                 ordering  = FALSE,
                                 columnDefs = colDef,
                                 autoWidth = FALSE
                  ))
  })
  
}

shinyApp(ui, server)

Solution

  • I used the information from @K-Rhode from this answer: https://stackoverflow.com/a/49513444/4375992

    From what I can tell, your primary issue is that the column width of the checkbox is too wide, yes? Well this should do it. Add a classname to the columnDefs for the checkbox column, then in css adjust the width of that class

    library(DT)
    library(shiny)
    
    ui <- basicPage(
      h2("The mtcars data"),
      DT::dataTableOutput("mytable"),
      tags$head( #CSS added to shrink the column with
        tags$style('td.small .shiny-input-container{width:auto;}
                    td.small{width:30px;}
                    ')
      )
    )
    
    server <- function(input, output) {
      
      shinyInput <- function(FUN, len, id, ...) {
        inputs <- character(len)
        for (i in seq_len(len)) {
          inputs[i] <- as.character(FUN(paste0(id, i), ...))
        }
        inputs
      }
      
      mtcarsx <- data.frame(mtcars, newvar=paste0(shinyInput(checkboxInput,nrow(mtcars),"mychbx",label=NULL,value=FALSE,width=NULL)))
      
      colDef <- list(
        list(
          targets=0,
          width="150px"
        ),
        list(
          targets=1,
          width="300px"
        ),
        list(
          targets=2,
          width="500px"
        ),
        list(
          targets = 11,
          className = "small" #Class name added so we can adjust the width of the checkbox element above in CSS
        )
      )
      
      output$mytable = DT::renderDataTable({
        DT::datatable(mtcarsx, 
                      escape = FALSE, 
                      selection = 'none', 
                      rownames = FALSE, 
                      options = list(searching = FALSE, 
                                     ordering  = FALSE,
                                     columnDefs = colDef,
                                     autoWidth = FALSE
                      ))
      })
      
    }
    
    shinyApp(ui, server)
    

    To address the comment by @tomsu asking how to implement in modules, I don't think anything special is needed as I still use the same small tag for each dataframe and it works. Here is example code with modules that works for me:

    library(shiny)
    
    Table_ui <- function(id) {
      DT::dataTableOutput(NS(id, "mytable"))
    }
    
    shinyInput <- function(FUN, len, id, ...) {
      inputs <- character(len)
      for (i in seq_len(len)) {
        inputs[i] <- as.character(FUN(paste0(id, i), ...))
      }
      inputs
    }
    
    mtcarsx <- data.frame(mtcars, newvar=paste0(shinyInput(checkboxInput,nrow(mtcars),"mychbx",label=NULL,value=FALSE,width=NULL)))
    
    Table_server <- function(id) {
      moduleServer(id, function(input, output, session) {
      output$mytable <- DT::renderDataTable({
        DT::datatable(mtcarsx, 
                      escape = FALSE, 
                      selection = 'none', 
                      rownames = FALSE, 
                      options = list(searching = FALSE, 
                                     ordering  = FALSE,
                                     columnDefs = colDef,
                                     autoWidth = FALSE
                      ))
      })
      })
    }
    
    colDef <- list(
      list(
        targets=0,
        width="150px"
      ),
      list(
        targets=1,
        width="300px"
      ),
      list(
        targets=2,
        width="500px"
      ),
      list(
        targets = 11,
        className = "small" #Class name added so we can adjust the width of the checkbox element above in CSS
      )
    )
    
    ui <- basicPage(
      h2("The mtcars data"),
      # DT::dataTableOutput("mytable"),Table_ui
      Table_ui(1),
      Table_ui(2),
      Table_ui(3),
      tags$head( #CSS added to shrink the column with
        tags$style('td.small .shiny-input-container{width:auto;}
                    td.small{width:30px;}
                    ')
      )
    )
    
    server <- function(input, output, session) {
      
      Table_server(1)
      Table_server(2)
      
    }
    
    shinyApp(ui, server)