Невозможно загрузить заголовки данных, используя DT: Custom Container в ShinyApp - PullRequest
Новая
       32

Невозможно загрузить заголовки данных, используя DT: Custom Container в ShinyApp

0 голосов
/ 23 ноября 2018

Я использую библиотеку DT :: Datatable в R для сборки ShinyApp.Когда я загружаю данные с помощью кнопок, они не отображают верхние заголовки «Sepal» и «Petal» в Excel.Я также прилагаю свой код.После запуска кода нажмите , откройте в браузере вверху и затем загрузите.Я был бы очень благодарен, если бы кто-то мог разобраться.Большое спасибо:)

Мой код: 

library(shiny)
library(DT)
library(dplyr)

iris<-iris[,c(5,1:4)]

ui =basicPage(
tags$head(
tags$style(type = "text/css",
           HTML("th { text-align: center; }")  )),

selectInput(inputId = "Species", 
          label = "Species:",
          choices = c("All",
                      unique(as.character(iris$Species)))),

checkboxGroupInput(inputId = "columns", label = "Select Variable:",
                 choices =c("Sepal.Length", "Sepal.Width", "Petal.Length", 
                            "Petal.Width"),
                 selected = c("Sepal.Length", "Sepal.Width", "Petal.Length", 
                              "Petal.Width")),

h2('Iris Table'),
DT::dataTableOutput('mytable') )

server = function(input, output) {
output$mytable = DT::renderDataTable({


validate(need(all(grepl("[Sepal|Petal]\\.[Length|Width]", input$columns)), 
"Invalid choices"))

header_df <- tibble(part = character(), dimension = character())

if (!is.null(input$columns)) {
  header_df <- strsplit(input$columns, ".", fixed = TRUE) %>%
    lapply(function(x) tibble(part = x[1], dimension = x[2])) %>%
    dplyr::bind_rows() }

sepal_dims <- header_df %>% filter(part == "Sepal") %>% pull(dimension)
petal_dims <- header_df %>% filter(part == "Petal") %>% pull(dimension)

# a custom table container
sketch = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 2, 'Species'),
      if (length(sepal_dims))
        th(colspan = length(sepal_dims), 'Sepal'),
      if (length(petal_dims))
        th(colspan = length(petal_dims), 'Petal')),
    tr(
      lapply(sepal_dims, th),
      lapply(petal_dims, th)
    )) )) 

DT::datatable( rownames = FALSE, container = sketch,
               extensions = 'Buttons',
               options = list(dom = 'Bfrtip',
                              buttons = 
                                list('colvis', list(
                                  extend = 'collection',
                                  buttons = list(list(extend='csv',
                                                      filename = 'hitStats'),
                                                 list(extend='excel',
                                                      filename = 'hitStats'),
                                                 list(extend='pdf',
                                                      filename= 'hitStats'),
                                                 list(extend='copy',
                                                      filename = 'hitStats'),
                                                 list(extend='print',
                                                      filename = 'hitStats')),

                                  text = 'Download' ))),
               {

                 data<-iris

                 if(input$Species != 'All'){
                   data<-data[data$Species == input$Species,]
                 }    

                 data<-data[,c("Species",input$columns),drop=FALSE]   

                 data   
               }) })    }

shinyApp(ui = ui, server = server)
...