Read More Buttons for Long Text in R Shiny DT Datatables-CodePudding

I would like to include "read more" and "read less" buttons in my R Shiny DT datatables for cells with overflow / long text.

This wonderful answer by Devansh J demonstrates this functionality in a pure CSS / javascript datatable. You can click the "run code snippet" button to see it in action.

Unfortunately, I'm having trouble achieving the same result in a shiny app. I've also reviewed other answers, 1 and 2, but they don't get me any closer to a solution for datatables in the shiny context. Hopefully, Yihui can step in and save the day!

Here is a MWE that would benefit from text overflow buttons.

library(shiny)
library(DT)
library(shinipsum)

text_df = data.frame(
  numbers = 1:3,
  letters = LETTERS[1:3],
  text = c("Lorem", substr(shinipsum::lorem, 1, 100), substr(shinipsum::lorem, 1, 5000))
)

# Define UI for application that draws a histogram
ui <- fluidPage(
  dataTableOutput("text_table")
)

# Define server logic required to draw a histogram
server <- function(input, output) {
   output$text_table = renderDataTable({
     datatable(text_df)
   })
}

shinyApp(ui = ui, server = server)

CodePudding user response：

Indeed very cool. No need of Shiny.

library(DT)
library(shinipsum)

text_df <- data.frame(
  numbers = 1:3,
  letters = LETTERS[1:3],
  text    = c(
    "Lorem", 
    substr(shinipsum::lorem, 1, 100), 
    substr(shinipsum::lorem, 1, 5000)
  )
)

js <- "
function(cell) {
  var $cell = $(cell);
  $cell.contents().wrapAll('<div class=\\\"content\\\"></div>');
  var $content = $cell.find('.content');
  $cell.append($('<button>Read more</button>'));
  $btn = $cell.find('button');
  $content.css({
    height: '50px',
    overflow: 'hidden'
  });
  $cell.data('isLess', true);
  $btn.click(function () {
    var isLess = $cell.data('isLess');
    $content.css('height', isLess ? 'auto' : '50px');
    $(this).text(isLess ? 'Read less' : 'Read more');
    $cell.data('isLess', !isLess);
  });
}
"
datatable(
  text_df,
  rownames = FALSE,
  options = list(
    "columnDefs" = list(
      list(
        "targets" = 2,
        "createdCell" = JS(js)
      )
    )
  )
)