Shiny - 如何使用renderUI和eventReactive发送更新的数据？

Question

我希望仅在单击提交按钮时将表单数据发送到服务器，因此我使用eventReactive方法。我还使用renderUI方法渲染表单元素。最后，我使用observe方法观察表单元素中的更改 - 如果单击 Plot 2 中的任何单选按钮，则更新并取消选择 Plot中的单选按钮1 ，反之亦然。

因此，当您单击提交按钮时，我预计来自Plot 1的数据为NULL，但我从服务器端获得的数据仍然是值。以下是我的测试代码。

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()
  })
})

我做错了什么？如何按上述方式发送数据？

Answer 1

不幸的是，使用updateRadioButtons()只会更新ui中的单选按钮，而不会影响实际的input$值。要将input$值实际设置为NULL，我们可以使用Shiny.addCustomMessageHandler。

为此，我们可以将脚本添加到ui.R

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

然后我们在更新server.R

中的单选按钮时使用此消息处理程序

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

以下是我认为解决您问题的完整实现。此外，我将observe转换为observeEvent，因为他们有特定的事件，他们正在做出反应。

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()
  })
})