reactivity dependent on conditional confirmation dialog

Question

In this minimal example, how can I update the textOutput only after the confirmation of the modalDialog buttons for the change png -> svg. (svg-> png requires no confirmation)

The confirmation dialog should be available only for the change png -> svg (and other conditions not shown), not the way back.

As the main input affects several reactive outputs (not shown), it is desirable to use reactiveValues.

library(shiny)

ui = fluidPage(
  mainPanel(
    radioButtons("selectFormat", "Select Format",c("svg","png") ),
    uiOutput("textOut")
  )
)

server = function(session, input, output) {
  
  values<-reactiveValues()
  
  output$textOut <- renderUI({
    textOutput("selection")
  })
  
  observe({
    values[["format"]]<-input$selectFormat
  })
  
  output$selection <-renderText({
    paste(values[["format"]], "is selected" )
  })
  
  observeEvent(input$selectFormat, ignoreInit = T, {
    if (input$selectFormat=="svg") {
    showModal(modalDialog(
      title="Warning: When changing to '.svg' with condition X, Rstudio will crash",
      footer = tagList(actionButton("confirmSvg", "Select .svg anyway"),
                       
                       actionButton("confirmPng", "stay with .png as suggested")
      )
    ))
    }
  })
  
  observeEvent(input$confirmSvg, {
    updateRadioButtons(session,inputId = "selectFormat", selected="svg")
    removeModal()
  })
  observeEvent(input$confirmPng, {
    updateRadioButtons(session,inputId = "selectFormat", selected="png")
    removeModal()
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

YBS · Answer 1 · 2021-04-09T13:39:16.133

Perhaps you are looking for this

library(shiny)

ui = fluidPage(
  mainPanel(
    radioButtons("selectFormat", "Select Format",choices=c("svg","png") ),
    uiOutput("textOut")
  )
)

server = function(session, input, output) {

  values <- reactiveValues()
  observe({values$sel <- input$selectFormat})
  
  observeEvent(input$selectFormat, ignoreInit = F, {
    if (input$selectFormat=="svg") {
      showModal(modalDialog(
        title="Warning: When changing to '.svg' with condition X, Rstudio will crash",
        footer = tagList(actionButton("confirmSvg", "Select .svg anyway"),

                         actionButton("confirmPng", "stay with .png as suggested")
        )
      ))
    }
  })

  observeEvent(input$confirmSvg, {
    updateRadioButtons(session,inputId = "selectFormat", selected="svg")
    removeModal()
  }, ignoreInit = T)
  observeEvent(input$confirmPng, {
    updateRadioButtons(session,inputId = "selectFormat", selected="png")
    removeModal()
  }, ignoreInit = TRUE)

  output$textOut <- renderUI({
    value <- values$sel # input$selectFormat
    if (tryCatch(is.numeric(input$confirmPng), error=function(e) FALSE) & 
        tryCatch(is.numeric(input$confirmSvg), error=function(e) FALSE)
    ) {
      if (input$selectFormat=="svg" & (input$confirmPng>0 | input$confirmSvg<1) ) {
        value <- "png"
      }
    }
    paste(value, "is selected" )
  })
  
}

# Run the application
shinyApp(ui = ui, server = server)

Ferroao · Accepted Answer · 2021-04-10T03:24:57.067

Despite YBS answer with minor modifications worked in the minimal example OP, in real world did not.

So I found this approach, which works in the minimal example and real world:

library(shiny)

ui = fluidPage(
  mainPanel(
    radioButtons("selectFormat", "Select Format",choices=c("svg","png"),"svg" )
    ,uiOutput("textOut")
  )
)

server = function(session, input, output) {
  
  values<-reactiveValues(stop=FALSE,text="svg")
  
  observeEvent(input$selectFormat, ignoreInit=TRUE, {
    if(input$selectFormat=="svg") {
      showModal(modalDialog(
        title = "WARNING"
        ,".svg and other conditions (not shown) can cause Rstudio or browser to crash"
        ,easyClose = TRUE,
        footer = list(
          actionButton("confirmSvg", "Choose .svg (not recommended)"),
          actionButton("confirmPng", "Leave .png as suggested")
        ) )
      )
      values[["stop"]] <- TRUE
    } else {
      values[["text"]] <- input$selectFormat
      values[["stop"]] <- FALSE
    }
  })
  
  observeEvent(input$confirmSvg, {
    removeModal()
    updateRadioButtons(session,inputId = "selectFormat", selected="svg")
    values[["text"]] <- "svg"
    values[["stop"]] <- FALSE
  })
  
  observeEvent(input$confirmPng, {
    removeModal()
    updateRadioButtons(session,inputId = "selectFormat", selected="png")
    values[["stop"]] <- FALSE
    values[["text"]] <- "png"
  })
  
  output$textOut <- renderUI({
    validate(need(try(values[["stop"]]==FALSE),"not ready" ) )
    paste(values[["text"]], "is selected" )
  })
  
}

shinyApp(ui = ui, server = server)

reactivity dependent on conditional confirmation dialog

2 Answers2