我正在R中使用DT :: Datatable库来构建ShinyApp。 当我使用按钮下载数据时,它不会在excel中显示“ Sepal”和“ Petal”的顶部标题。我还附上了我的代码。运行代码后,请点击顶部的在浏览器中打开,然后下载。 如果有人可以解决我,我将不胜感激。非常感谢:)
我的代码:
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)