Reducing the space when on DT tables

[vinayprakash808]

Hi all,

Below is the sample code. When the user clicks on "More Info" the drop down appears (that is fine). But it is taking more space. Can not reduce this space? Like refer below

library(tidyverse)
library(DT)
library(xtable)
library(shiny)


library(shiny)

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

server <- function(input, output, session) {
  
  samdt <- structure(list(Domain = c("a", "a", "b", "b", "b"), 
                          sub_domain = c("a1", "a1", "b1", "a1", "b1"), 
                          Reviews = c(1234, 2311, 3123, 4311, 5211),
                          Ratings = c(1,2,1,2,1),
                          text = c("asd","dfdsf","sdfs","sdfs","sdf")), row.names = c(NA,-5L), class = c("tbl_df", "tbl", "data.frame"))
  new_sam <- samdt %>% group_by(Domain) %>% summarise(nReviews = n())
  subs <- samdt %>% group_by(Domain, sub_domain) %>% summarise(nReviews = n(),Ratings_e = toString(Ratings), Text_e = toString(text),
                                                               table_html = purrr::map2(Ratings_e,Text_e,
                                                                                  function(ca,cb){
                                                       
                                                                                    ca <- unlist(strsplit(ca,','))
                                                                                    cb <- unlist(strsplit(cb,','))
                                                                                    p1 <- '<table border=1><tr><th>Ratings_e</th><th>Text_e</th></tr>'
                                                                                    p2 <- paste(glue::glue("<tr><td>{ca}</td><td>{cb}</td></tr>"),collapse = '')
                                                                                    p3 <- '</table>'
                                                                                    
                                                                                    paste(p1,p2,p3,sep='')
                                                                                  })) %>% ungroup() %>% mutate(
                                                                                    rn=row_number(),
                                                                                    launcher_html = 
                                                                                      glue('<script>  
  function openWindow{rn}() {{  
    var newtab{rn} = window.open("", "anotherWindow", "width=300,height=150");  
    newtab{rn}.document.open();
    newtab{rn}.document.write("{table_html}");  
  }}  
</script>  
  
  <button onclick="openWindow{rn}()"> Open Window </button>  
   ')
                                                                                    ) %>%   group_by(Domain) %>% nest() %>% rowwise() %>% mutate(
                                                                                    htmltab = HTML(print(xtable(data),type="HTML",
                                                                                                         sanitize.text.function=function(x)x))
                                                                                  )
  
  samdt_x <- left_join(new_sam,subs)
  
  add_collapse_content <- function(x, id) {
    tagList(
      tags$button(
        "data-toggle" = "collapse",
        "data-target" = paste0("#", id),
        "More Info"
      ),
      div(
        "id" = id,
        "class" = "collapse",
        x
      )
    )  %>% as.character()
  }
  
  samdt_x2 <- samdt_x %>% rowwise() %>% mutate(html_buttons = 
                                                 add_collapse_content(htmltab,Domain)) %>%
    relocate(html_buttons) %>% select(-data,-htmltab)
  
  output$table <- renderDT({
    datatable(samdt_x2,rownames = F,escape = F
              ,options = list(
                columnDefs = list(
                  list(orderable = FALSE, className = 'details-control', targets = c(0))
                ))
    )})
}

shinyApp(ui, server)

Actual output

Expected output. So basically when clicked on "More Info", other columns should not be expanded. It should be be the way they are but the drop down down table should more or less consume entire row. As shown in attached