R Shiny中如何通过单选按钮触发downloadHandler下载模态框

要实现点击「Downloads」单选按钮直接唤起下载模态框，仅需要做两处核心调整即可： #

调整步骤 #

1. UI层删除多余中间按钮
   删除主面板Balances标签下原有的Download动作按钮代码，省略中间跳转步骤
2. Server层新增单选按钮监听逻辑
   新增监听器检测单选框mainPanelBtnTab2的取值，当选中值为Downloads时直接触发下载模态框弹出

完整修改后代码 #

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") 
  ),
    
  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
           )
         ),
                 
         conditionalPanel(condition = "input.mainPanelBtnTab2 == 'Vector plots'",plotOutput("graph1")),
         conditionalPanel(condition = "input.mainPanelBtnTab2 == 'Vector values'",DTOutput("table1"))
         # 已删除原有的Download动作按钮
                 
      ),
      id = "tabselected"
  )
 )
)

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"))
      )
    )
  })
  
  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]))
  })
  
  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)))
  )

  output$download <- downloadHandler(
    filename = function() {paste("Yield","png",sep=".")},
    content = function(file){
      {png(file)
        vectorPlot(yield(),"Annual yield","Period","Rate")
        dev.off()}
    }
  )
  
  # 新增：监听单选按钮选中Downloads时直接弹出模态框
  observeEvent(input$mainPanelBtnTab2, {
    if(input$mainPanelBtnTab2 == "Downloads"){
      showModal(modalDialog(
        selectInput("downloadItem","Selection:",c("Yield plot")),
        downloadButton("download", "Download")
      ))
    }
  })

})

shinyApp(ui, server)

注：原示例代码因做了精简处理，缺少matrix2Input、matrixLink等自定义函数，运行时出现相关报错属于正常情况，不影响「单选按钮唤起模态框」功能的验证，只需确认点击「Downloads」选项时模态框正常弹出即可。

内容的提问来源于stack exchange，提问作者Curious Jorge - user9788072