Shiny - how to send updated data with renderUI and eventReactive?

Question

I want to send the form data to server only when the submit button is clicked, so I use eventReactive method. I also render the form elements using renderUI method. Lastly, I use observe method to observe changes in the form elements - if any of the radio buttons in Plot 2 is clicked, then I update and deselect the radio buttons in Plot 1, and vice versa.

So when you click the submit button, I expect the data from Plot 1 is NULL, but the data that I get from the server side is still a value. Below is my test code.

ui.R

library(shiny)

# Define UI for application that draws a histogram
shinyUI(fluidPage(

  # Application title
  titlePanel("Hello Shiny!"),

  # Sidebar with a slider input for the number of bins
  sidebarLayout(
    sidebarPanel(
      uiOutput("plot1Ui"),
      uiOutput("plot2Ui"),
      actionButton('goPlot', 'Enter')
    ),

    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("plot")
    )
  )
))

server.R

library(shiny)

# Define server logic required to draw a histogram
shinyServer(function(input, output, session) {

  output$plot1Ui <- renderUI({
    radioButtons(
        inputId = "plot1",
        label = "Plot 1:",
        choices = c(
            "Option 1" = "1",
            "Option 2" = "2",
            "Option 3" = "3"
        ),
        selected = NULL,
        inline = FALSE
    )
  })

  output$plot2Ui <- renderUI({
    radioButtons(
        inputId = "plot2",
        label = "Plot 2:",
        choices = c(
            "Option A" = "A",
            "Option B" = "B",
            "Option C" = "C"
        ),
        selected = character(0),
        inline = FALSE
    )
  })

  observe({
      plot1 <- input$plot1
      if (!is.null(plot1) && plot1 != '1') {
          updateRadioButtons(
            session,
            "plot2",
            label = "Plot 2:",
            choices = c(
                "Option A" = "A",
                "Option B" = "B",
                "Option C" = "C"
            ),
            selected = character(0),
            inline = FALSE
        )
      }
  })

  observe({
      plot2 <- input$plot2
      if (!is.null(plot2)) {
          updateRadioButtons(
            session,
            "plot1",
            label = "Plot 1:",
            choices = c(
                "Option 1" = "1",
                "Option 2" = "2",
                "Option 3" = "3"
            ),
            selected = character(0),
            inline = FALSE
        )
      }
  })

  # Call this only when the button is pressed.
  eventPlot <- eventReactive(input$goPlot, {
    cat('\n')
    cat('Plot 1:')
    str(input$plot1)

    cat('\n')
    cat('Plot 2:')
    str(input$plot2)
  })

  output$plot <- renderPlot({
      # render the plot from eventReactive.
      eventPlot()
  })
})

What have I done wrong? How can I send the data as I described above?

Answer 1

Using updateRadioButtons() unfortunately just updates the radio button in the ui without affecting the actual input$ value. To actually set the input$ value to a NULL we can use Shiny.addCustomMessageHandler.

To do this we can add a script to ui.R

tags$script("
    Shiny.addCustomMessageHandler('resetValue', function(variableName) {
      Shiny.onInputChange(variableName, null);
    });
  ")

and then we utilize this message handler while updating the radio buttons in server.R

session$sendCustomMessage(type = "resetValue", message = "inputid")

Below are full implementations of this that I think address your question. Additionally I converted the observes to observeEvents since they have a specific event they're reacting to.

ui.R

library(shiny)

# Define UI for application that draws a histogram
shinyUI(fluidPage(
  tags$script("
    Shiny.addCustomMessageHandler('resetValue', function(variableName) {
      Shiny.onInputChange(variableName, null);
    });
  "),
  # Application title
  titlePanel("Hello Shiny!"),

  # Sidebar with a slider input for the number of bins
  sidebarLayout(
    sidebarPanel(
      uiOutput("plot1Ui"),
      uiOutput("plot2Ui"),
      actionButton('goPlot', 'Enter')
    ),

    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("plot")
    )
  )
))

server.R

library(shiny)

# Define server logic required to draw a histogram
shinyServer(function(input, output, session) {

  output$plot1Ui <- renderUI({
    radioButtons(
      inputId = "plot1",
      label = "Plot 1:",
      choices = c(
        "Option 1" = "1",
        "Option 2" = "2",
        "Option 3" = "3"
      ),
      selected = character(0),
      inline = FALSE
    )
  })

  output$plot2Ui <- renderUI({
    radioButtons(
      inputId = "plot2",
      label = "Plot 2:",
      choices = c(
        "Option A" = "A",
        "Option B" = "B",
        "Option C" = "C"
      ),
      selected = character(0),
      inline = FALSE
    )
  })

  observeEvent(input$plot1, {
    updateRadioButtons(session,
                       inputId = "plot2",
                       label = "Plot 2:",
                       choices = c(
                         "Option A" = "A",
                         "Option B" = "B",
                         "Option C" = "C"
                       ),
                       selected = character(0),
                       inline = FALSE)
    session$sendCustomMessage(type = "resetValue", message = "plot2")
  })

  observeEvent(input$plot2, {
    updateRadioButtons(session,inputId = "plot1",
                       label = "Plot 1:",
                       choices = c(
                         "Option 1" = "1",
                         "Option 2" = "2",
                         "Option 3" = "3"
                       ),
                       selected = character(0),
                       inline = FALSE)
    session$sendCustomMessage(type = "resetValue", message = "plot1")
  })

  # Call this only when the button is pressed.
  eventPlot <- eventReactive(input$goPlot, {
    cat('\n')
    cat('Plot 1:')
    str(input$plot1)

    cat('\n')
    cat('Plot 2:')
    str(input$plot2)

    plot(rnorm(100))
  })

  output$plot <- renderPlot({
    # render the plot from eventReactive.
    eventPlot()
  })
})