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

Question

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

请注意，为了便于理解，下面的 MWE 在 post 中被严重削减了。当运行时，它可能在某些地方显得“不稳定”，但这不应该影响此 post 使用单选按钮调用模式对话的要点。顺便说一句，我不认为它可以进一步削减，而不会失去我的一些解决方案测试能力！

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 更改为 observe 并在单选按钮中选择“下载”时将对话框运行更改为

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

Answer 2

你也可以坚持使用 observeEvent:

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

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

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

In R Shiny, how to invoke download handler from radio buttons?

r

download

shiny

shiny-reactivity