Объединение кнопок загрузки в одиночный с параметрами - PullRequest
Новая
       5

Объединение кнопок загрузки в одиночный с параметрами

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

В моем приложении есть несколько кнопок для загрузки разных наборов данных, но они стали неуклюжими, и я бы хотел их почистить.В идеале, у меня была бы одна кнопка, и при нажатии рядом с ней появляется небольшое всплывающее окно, которое отображает все оригинальные кнопки загрузки.Точно так же, как 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)

1 Ответ

0 голосов
/ 15 октября 2018

Разобрался, используя 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)
...