Закрепить верхний и нижний колонтитул в Datatable внутри коробки () - Shiny Dashboard - PullRequest
0 голосов
/ 11 июня 2018

Я новичок в блеске.Я хочу, чтобы верхний и нижний колонтитул таблицы данных в блестящей приборной панели были исправлены.Пожалуйста, помогите мне найти решение.

Мой код,

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 HeaderFixed Footer

Спасибо, SJB

1 Ответ

0 голосов
/ 19 июня 2018

Я узнал ответ.Вместо указания 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)
...