Search code examples
rshinydownloadshiny-reactivity

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


In running the below MWE code, I would like to be able to click the radio button appearing in the main panel labeled "Downloads" and invoke the already baked-in modal dialogue for downloading, as shown in the first image at the bottom. The only way I've been able to get this to work is by using an intermediary action button (labeled "Download") appearing in the main panel right below the radio buttons, which appears after clicking the "Downloads" radio button, as shown in the 2nd image below. How do I eliminate this intermediary action button and go straight from clicking the appropriate radio button to the download modal dialogue?

Note that the below MWE is severely cut down for ease of understanding in this post. It may appear "wonky" in places when running but this shouldn't affect the point of this post for using a radio button to invoke a modal dialogue. Btw I don't think it can be cut back further, without losing some of my solution testing capabilities!

MWE code:

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)

enter image description here

enter image description here


Solution

  • You may also stick with observeEvent:

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

    Or use if instead of req as @RonakShah did.