R Shiny dataTableOutput - prevent column from showing full text column - r

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 )")
))
)
)