在 R Shiny 中，如何从单选按钮调用下载处理程序？

Question

在运行下面的 MWE 代码时，我希望能够单击出现在主面板中标有“下载”的单选按钮，并调用已经内置的模式对话框进行下载，如第一张图片所示底部。我能够让它工作的唯一方法是使用出现在主面板中单选按钮正下方的中间操作按钮（标记为“下载”），该按钮在单击“下载”单选按钮后出现，如图所示在下面的第二张图片中。如何消除此中间操作按钮并直接从单击相应的单选按钮进入下载模式对话框？

请注意，为了便于理解，下面的 MWE 被严重删减。运行时它可能会在某些地方出现“不稳定”，但这不应该影响这篇文章的重点，即使用单选按钮调用模态对话。顺便说一句，如果不失去我的一些解决方案测试能力，我认为不能进一步削减它！

MWE 代码：

library(shiny)
library(shinyMatrix)
library(shinyjs)
library(DT)

matrix1Input <- function(x){
  matrixInput(x, 
              value = matrix(c(0.2), 1, 1, dimnames = list(c("Yield"),NULL)),
              rows = list(extend = FALSE,  names = TRUE),
              cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

vectorBase <- function(x,y){
  a <- rep(y,x)                         
  b <- seq(1:x)                         
  c <- data.frame(x = b, y = a)         
  return(c)}

vectorPlot <- function(w,x,y,z){plot(w,main=x,xlab=y,ylab=z)}

ui <- pageWithSidebar(
  
  headerPanel("Model"),
  
  sidebarPanel(
    fluidRow(helpText(h5("Base Input Panel"))),
    uiOutput("Panels") 
  ), # close sidebar panel
    
  mainPanel(
    tabsetPanel(
      tabPanel("Balances", value=2,
         fluidRow(
           radioButtons(
             inputId = 'mainPanelBtnTab2',
             label = h5(strong(helpText("Asset outputs:"))),
             choices = 
               c('Vector plots','Vector values','Downloads'),
             selected = 'Vector plots',
             inline = TRUE
           ) # close radio buttons
         ), # close fluid row
                 
         conditionalPanel(condition = "input.mainPanelBtnTab2 == 'Vector plots'",plotOutput("graph1")),
         conditionalPanel(condition = "input.mainPanelBtnTab2 == 'Vector values'",DTOutput("table1")),
         fluidRow(actionButton("showDownload", "Download")),
                 
      ),  # close tab panel
      id = "tabselected"
  ) # close tabset panel
 ) # close main panel
) # close page with sidebar

server <- function(input,output,session)({
  periods                <- reactive(input$periods)
  base_input             <- reactive(input$base_input)
  yield_vector_input     <- reactive(input$yield_vector_input)

  vectorVariable <- function(x,y){
    if(input$showVectorBtn == 0) vectorBase(input$periods,x)
    else vectorMultiFinal(input$periods,matrixValidate(input$periods,y))}
  
  yield  <- function(){vectorVariable(input$base_input[1,1],yield_vector_input())}

  output$Panels <- renderUI({
    tagList( 
      conditionalPanel(
          condition="input.tabselected==2",
          sliderInput('periods','',min=1,max=120,value=60),
          matrix1Input("base_input"),
          useShinyjs(),
          actionButton('showVectorBtn','Show'), 
          actionButton('hideVectorBtn','Hide'),
          actionButton('resetVectorBtn','Reset'),
          hidden(uiOutput("Vectors"))
      ) # close conditional panel
    ) # close tagList
  }) # close renderUI
  
  renderUI({matrixLink("yield_vector_input",input$base_input[1,1])})
  
  output$Vectors <- renderUI({
    input$resetVectorBtn
    tagList(matrix2Input("yield_vector_input",input$periods,input$base_input[1,1]))
  }) # close render UI
  
  observeEvent(input$showVectorBtn,{shinyjs::show("Vectors")})
  observeEvent(input$hideVectorBtn,{shinyjs::hide("Vectors")})
  
  output$graph1 <-renderPlot(vectorPlot(yield(),"A","Period","Rate"))

  vectorsAll <- reactive({cbind(Period  = 1:periods(),Yld_Rate = yield()[,2])})
  
  output$table1 <- renderDT({vectorsAll()},
                            options=list(columnDefs=list(list(className='dt-center',targets=0:1)))
  ) # close renderDT

  output$download <- downloadHandler(
    filename = function() {paste("Yield","png",sep=".")},
    content = function(file){
      {png(file)
        vectorPlot(yield(),"Annual yield","Period","Rate")
        dev.off()}
    } # close content function
  ) # close download handler
  
  observeEvent(input$showDownload,
               {showModal(modalDialog(
                 selectInput("downloadItem","Selection:",c("Yield plot")),
                 downloadButton("download", "Download")
               ))} 
  ) # close observeEvent

}) # close server

shinyApp(ui, server)

Answer 1

你也可以坚持observeEvent:

  observeEvent(input$mainPanelBtnTab2,{
    req(input$mainPanelBtnTab2 == "Downloads")
    showModal(modalDialog(
      selectInput("downloadItem","Selection:",c("Yield plot")),
      downloadButton("download", "Download")
    ))}
  ) # close observeEvent

或者像@RonakShah 那样使用if 而不是req。

Answer 2

您可以将下载按钮上的observeEvent 更改为observe，然后在您选择“下载”单选按钮时运行对话框。

observe({
    if(input$mainPanelBtnTab2 == "Downloads") {
      showModal(modalDialog(
                 selectInput("downloadItem","Selection:",c("Yield plot")),
                 downloadButton("download", "Download")
      ))
  } 
  })