冻结数据框内的页眉和页脚() - 闪亮仪表板

时间:2018-06-11 11:21:00

标签: r shiny shinydashboard

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

我的代码,

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)

请查看以下屏幕截图以获取进一步说明,

Fixed Header Fixed Footer

由于 SJB

1 个答案:

答案 0 :(得分:0)

I found out the answer. Instead of giving scrollY = T, height of the datatable can be specified. Thus creating a scroll when the need arises.

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)