R Shiny dataTableOutput - prevent column from showing full text column

Question

I have code to present a table in my R Shiny application. There is a character column where the value within a given cell can be a large number of characters. I use the following code to create the table:

output$data_table <- DT::renderDataTable({
    
    req(data_go_go())
    data_go_go()
    
},rownames = FALSE,filter = "top")

Then display the table with:

DT::dataTableOutput("data_table")

This code results in the following table:

You can see the string in the last column is causing the table to extend very far to the right. Is there a way I can prevent the column from displaying the entire string, and let it display the whole text if you hover over the particular cell?

Answer 1

Here is one option, borrowed heavily from this SO answer written by Stéphane Laurent (R shiny DT hover shows detailed table)

library(shiny)
library(DT)

g = data.frame(
  TermID = c("GO:0099536", "GO:0009537", "GO:0007268"),
  TermLabel = rep("synaptic signaling",times=3),
  Reference= c(907,878,869),
  Genes=c(78,74,72),
  FoldEnrichment=c(13.69,17.11,14.22),
  AdjPValue = c(0,0,0),
  `Gene Info` = "Gene Information",
  GenesDetail= replicate(paste0(sample(c(" ", letters),100,replace=TRUE), collapse=""),n=3)
)

callback <- c(
  "table.on('mouseover', 'td', function(){",
  "  var index = table.cell(this).index();",
  "  Shiny.setInputValue('cell', index, {priority: 'event'});",
  "});"
)

ui <- fluidPage(DTOutput("geneTable"))

server <- function(input, output, session){
  
  output[["geneTable"]] <- renderDT({
    datatable(g[,1:7],callback = JS(callback))
  })
  
  filteredData <- eventReactive(input[["cell"]], {
    if(input[["cell"]]$column == 7){
      return(g[input[["cell"]]$row + 1, "GenesDetail", drop = FALSE])
    }
  })
  
  output[["tblfiltered"]] <- renderDT({
    datatable(filteredData(),fillContainer = TRUE, options=list(dom='t'),rownames = F)
  })
  
  observeEvent(filteredData(), {
    showModal(modalDialog(
        DTOutput("tblfiltered"), size = "l",easyClose = TRUE)
    )
  })
  
}

shinyApp(ui, server)

Answer 2

The easiest way is to use the ellipsis plugin:

library(DT) 

dat <- data.frame(
  A = c("fnufnufroufrcnoonfrncacfnouafc", "fanunfrpn frnpncfrurnucfrnupfenc"),
  B = c("DZDOPCDNAL DKODKPODPOKKPODZKPO", "AZERTYUIOPQSDFGHJKLMWXCVBN")
)

datatable(
  dat, 
  plugins = "ellipsis",
  options = list(
    columnDefs = list(list(
      targets = c(1,2),
      render = JS("$.fn.dataTable.render.ellipsis( 17, false )")
    ))
  )
)