冻结框内数据表的页眉和页脚（） - Shiny Dashboard答案

【问题标题】：Freeze Header and Footer of Datatable inside box() - Shiny Dashboard冻结框内数据表的页眉和页脚（） - Shiny Dashboard
【发布时间】：2018-06-19 19:13:26
【问题描述】：

我是闪亮的新手。我希望修复闪亮仪表板中数据表的页眉和页脚。请帮助我找到解决方案。

我的代码，

library(shiny)
library(shinydashboard)
library(DT)

ui <- dashboardPage(skin = "black", 
                    dashboardHeader(title = "Test"), 
                    dashboardSidebar(sidebarMenu(menuItem("Summary", tabName = "attrdat"))),                                        
                    dashboardBody(tabItem(tabName = "attrdat",
                                fluidRow(
                                  box(title = "Attribute Summary", width = 12,  status = "primary", 
                                      solidHeader = TRUE, collapsible = TRUE,DT::dataTableOutput("col_attr2"), style = "height:300px; overflow-y: scroll;overflow-x: scroll;")))))

server <- function(input, output, session) { 
  
  output$col_attr2 <- DT::renderDataTable({
      df <- data.frame(names(mtcars), sapply(mtcars, class), 
                       sapply(mtcars, function(x) length(unique(na.omit(x)))),
                       sapply(mtcars, function(x) sum(is.na(x))), 
                       (sapply(mtcars, function(x) sum(is.na(x)))/ nrow(mtcars)))
      names(df) <- c("Attribute","Data Type", "Distinct Records", "Missing Records","% Missing")
      tbe <- DT::datatable(df, rownames = FALSE, options = list(scrollX = TRUE,
                  columnDefs = list(list(className = 'dt-center', targets = 0:4)))) %>% 
                  formatPercentage(c("% Missing"), 0)
    })
  }
shinyApp(ui, server)

请查看以下屏幕截图以获得进一步说明，

谢谢 SJB

【问题讨论】：

标签： r shiny shinydashboard

【解决方案1】：

我找到了答案。可以指定数据表的高度，而不是给定 scrollY = T。从而在需要时创建一个卷轴。

library(shiny)
library(shinydashboard)
library(DT)

ui <- dashboardPage(skin = "black", 
                    dashboardHeader(title = "Test"), 
                    dashboardSidebar(sidebarMenu(menuItem("Summary", tabName = "attrdat"))),                                        
                    dashboardBody(tabItem(tabName = "attrdat",
                                fluidRow(
                                  box(title = "Attribute Summary", width = 12,  status = "primary", 
                                      solidHeader = TRUE, collapsible = TRUE,DT::dataTableOutput("col_attr2"), style = "height:500px;")))))

server <- function(input, output, session) { 

  output$col_attr2 <- DT::renderDataTable({
      df <- data.frame(names(mtcars), sapply(mtcars, class), 
                       sapply(mtcars, function(x) length(unique(na.omit(x)))),
                       sapply(mtcars, function(x) sum(is.na(x))), 
                       (sapply(mtcars, function(x) sum(is.na(x)))/ nrow(mtcars)))
      names(df) <- c("Attribute","Data Type", "Distinct Records", "Missing Records","% Missing")
      tbe <- DT::datatable(df, rownames = FALSE, options = list(scrollY = 300,
                  columnDefs = list(list(className = 'dt-center', targets = 0:4)))) %>% 
                  formatPercentage(c("% Missing"), 0)
    })
  }
shinyApp(ui, server)

【讨论】：