Question

在我的应用程序中，我有多个按钮来下载不同的数据集，但它已经变得笨重，我想清理它。理想情况下，我会有一个按钮，当单击时，旁边会出现一个小弹出窗口，显示所有原始下载按钮。正好DT使用Download按钮。

下面的代码显示了3个按钮（需要在视觉上组合）和一个数据表，显示了它的外观示例。

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

ui <- dashboardPage(skin='blue',
                      dashboardHeader(title = "Dashboard"),
                      dashboardSidebar(
                        br(),
                        downloadButton("Button1", "Button 1"),
                        br(),
                        downloadButton("Button2", "Button 2"),
                        br(),
                        downloadButton("Button3", "Button 3")
                      ),
                      dashboardBody(
                        box(
                          width = 12,
                          DT::dataTableOutput("Table")
                        )
                      )
  )

server = function(input, output,session) {

  Plant.Name <- c("PlantB","PlantA","PlantC","PlantA","PlantA","PlantA","PlantA","PlantB","PlantB","PlantB","PlantC","PlantC","PlantC","PlantC")
  Date <- c("1/1/2018","1/1/2018","1/1/2018","1/1/2018","1/2/2018","1/2/2018","1/2/2018","1/2/2018","1/3/2018","1/3/2018","1/3/2018","1/4/2018","1/4/2018","1/4/2018")
  Time <- c(5,6,4,3,6,5,2,1,4,3,1,3,5,2)

  Ship_data <- data.frame(cbind(Plant.Name,Date,Time))
  Ship_data$Plant.Name <- as.character(Ship_data$Plant.Name)
  Ship_data$Time <- as.numeric(as.character(Ship_data$Time))
  Ship_data$Date <- as.Date(as.character(Ship_data$Date))


  output$Button1 <- downloadHandler(
    filename = function(){paste("Test1 ",Sys.time(), ".csv", sep = "")},
    content = function(file){write.csv(Ship_data, file, row.names = FALSE)}
  )

  output$Button2 <- downloadHandler(
    filename = function(){paste("Test2 ",Sys.time(), ".csv", sep = "")},
    content = function(file){write.csv(Ship_data, file, row.names = FALSE)}
  )

  output$Button3 <- downloadHandler(
    filename = function(){paste("Test3 ",Sys.time(), ".csv", sep = "")},
    content = function(file){write.csv(Ship_data, file, row.names = FALSE)}
  )

  output$Table <- DT::renderDataTable({Ship_data}, 
  server = FALSE,
  rownames = FALSE,
  extensions = c('Buttons','Responsive'),
  options = list(
    dom = 'lfrtBip',
    buttons = list(list(
      extend = 'collection',
      buttons = list(list(extend='copy'),
                     list(extend='excel',
                          filename = "MRO Dash Export"),
                     list(extend='print')
      ),
      text = 'Download'
    ))
  )
  )


}

shinyApp(ui,server)

Answer 1

使用Modal弄清楚了。

library(shiny)
library (shinydashboard)

header <- dashboardHeader(title = "MRO Dash")
sidebar <- dashboardSidebar(actionButton("downloadBT", "Downloads", icon = icon("download")))
body <- dashboardBody(
  tags$head(tags$style("#test .modal-body {width: auto; height: auto;}"))
  )

ui <- dashboardPage(header, sidebar, body)

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

  myModal <- function() {
    div(id = "test",
      modalDialog(downloadButton("download1","Download Shipments tonight let's go"),
                  br(),
                  br(),
                  downloadButton("download2","Download Shipments"),
                  easyClose = TRUE, title = "Download Table")
    )
  }

  # open modal on button click
  observeEvent(input$downloadBT,
               ignoreNULL = TRUE,   # Show modal on start up
               showModal(myModal())
  )

  output$download1 <- downloadHandler(
    filename = function(){paste("MTD of SBU Shipments ",Sys.time(), ".csv", sep = "")},
    content = function(file){write.csv(, file, row.names = FALSE)}
  )

  output$download2 <- downloadHandler(
    filename = function(){paste("MTD of SBU Shipments ",Sys.time(), ".csv", sep = "")},
    content = function(file){write.csv(, file, row.names = FALSE)}
  )

}

shinyApp(ui, server)

将下载按钮与单个选项组合在一起

1 个答案: