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

Question

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)

score 2 · Answer 1 · answered Sep 13 '21 at 08:19

2

You may change the observeEvent on Download button to observe and run the dialog box when in radio button you have selected "Downloads".

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

answered Sep 13 '21 at 08:19

Ronak Shah

377,200
20
156
213

Arrggghh thank you that works nicely. But something new for me to wrestle with: observe vs. observeEvent. What's the difference? – Curious Jorge - user9788072 Sep 13 '21 at 08:44
1

As the name suggests `observeEvent` looks for an "event" to trigger, `observe` does not need that. This code would also work with `observeEvent` though. These are some links which might help https://stackoverflow.com/questions/53016404/advantages-of-reactive-vs-observe-vs-observeevent and https://stackoverflow.com/questions/60413024/r-shiny-understanding-the-difference-between-observe-and-observeevent-when-upd – Ronak Shah Sep 13 '21 at 08:55
So observe doesn't need a trigger event because of the use of the if statement afterwards? In effect the satisfying the "if" becomes the event? – Curious Jorge - user9788072 Sep 13 '21 at 08:58
1

No, `if` has nothing to do with it. By a trigger event I mean any input from the user. A click is an event, moving a cursor is event something like that. – Ronak Shah Sep 13 '21 at 09:10
1

`observe` by default reacts to all changes of reactive dependencies (in the expression passed to it), while `observeEvent` only is triggered by the dependencies explicitly listed in the `eventExpr`. I'd prefer `observeEvent` in this scenario, as you make sure to only trigger the modal once the button was clicked. If you change your code later on, adding reactives to this `observe` you might get confused why the modal is triggered. – ismirsehregal Sep 13 '21 at 09:31
Great explanations, I learned something new. – Curious Jorge - user9788072 Sep 13 '21 at 09:40

score 2 · Accepted Answer · answered Sep 13 '21 at 08:32

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.

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

2 Answers2