带有<br>的自定义表容器在R闪亮的数据表中不起作用

Question

##这是我在数据表中使用的容器，但列名中的 br 标记不起作用。 我在数据表中使用 escape = FALSE 但仍然面临同样的问题。 和 也不工作。我想要这样的列名=名字（在下一行）姓氏。

    test <- function(group,n){
  htmltools::withTags(th(colspan = n, group, class = "dt-center"))
}

myContainer <- htmltools::withTags(table(
  class = '',style="width:100%",
  thead(
    tr(
      th(rowspan = 2, ' '),
      th(colspan = 1, 'group 1', class = "dt-center"),
      th(colspan = 2, 'group 2', class = "dt-center"),
      th(colspan = 2, 'group 3', class = "dt-center")
    ),
    tr(
      th("new \\\\n ID"),
      lapply(c("SUBJID","SITE<br>ID","AG<br>E","SUBJID","RACE"), th)
    )
  )
))


Server <- function(input, output, session) {
  adae<-read_sas("C:/Arinjay_Intern/Work/ADaM/adae.sas7bdat")
  
  
  output$intTable<-renderDT({adae_df %>%
      
      datatable(class= 'compact', extensions = 'Buttons', rownames = F, container = myContainer,escape = FALSE,
                callback = JS(c("$('table.dataTable thead th').css('border-top', 'none');",
                                "$('table.dataTable.no-footer').css('border-top', 'none');"
                              )),
                options = list(dom = 'tB', pageLength = 5,
                               ordering = FALSE, class= "compact",
                               columnDefs = list(list(className = "dt-center", targets = "_all")),
                               buttons = 'pdf'
                               
                ),
                caption = htmltools::tags$caption(
                  style = 'caption-side: bottom; text-align: left;',
                  htmltools::em(HTML('N = number of subjects in the specified population. <br>n=number of subjects in each category. % = 100*n/N.')))
      ) %>%
      formatStyle(c("USUBJID","SUBJID","SITEID","AGE", "SEX","RACE"), backgroundColor = 'white')
    
  })
}

UI <-navbarPage(
  "DT Interactive Tables",
  tabPanel(
    "ADaM DataSets",
    fluidPage(
      checkboxGroupInput('group','Please select a group',c('FD_Cohort','MRD_Cohort')),
      textInput('n',"any value",value=2),
      DTOutput("intTable")
    )
  )
)


shinyApp(UI,Server)

预期输出：

Answer 1

无论是

\n

还是

<br>

，都在

xtable

工作。因此，您可以显式定义行，如下所示：

row1 <- c(" USUB","SUBJ","SITE","AG","SEX", "RACE")
row2 <- c("JID","ID","ID","E"," ", "")

myContainer <- htmltools::withTags(table(
  class = 'dt-center', style="width:100%",
  thead(
    tr( 
      th(colspan = 2, 'group 1', class = "dt-center"),
      th(colspan = 2, 'group 2', class = "dt-center"),
      th(colspan = 2, 'group 3', class = "dt-center")
    ),
    tr( lapply( row1, th) 
    ),
    tr( lapply( row2, th)
    )
  )
))

或者你可以用 css 或 js 编写一些东西来处理它。 上面的代码在虚拟数据集上给出了以下输出：