r - 具有动态文本的 ShinyApp 出现在多个 UI 元素的任何更改上

Question

我有兴趣开发一个按以下方式运行的 Shiny App:

1. 在用户界面元素数量发生任何变化后更新图表。 这是通过 actionButton 完成的/隔离构造。
2. 显示警告文本，提示用户单击更新 按钮。 杰出。
3. 在按下 Update 按钮后删除警告文本。 杰出。

例子

方法

• 取自 rstudio 提供的示例之一以下示例提供了对修改直方图的两个功能的访问。
• 直方图在点击更新按钮时更新。
• 与 UI 交互后 observeEvent构造应该更新随后传递给 renderText 的警告消息。
• 如果没有与 UI 的交互，renderText 可以返回空字符串。
• actionButton 应将警告消息字符串值恢复为空 c("")。 利用来自 insertUI 的替代方法/renderUI 是可以接受的。

代码

app.R

library(shiny)

ui <- fluidPage(titlePanel("Reactive UI"),
                sidebarLayout(
                    sidebarPanel(
                        # Reactive text should appear upon any change here
                        sliderInput(
                            "bins",
                            "Number of bins:",
                            min = 1,
                            max = 50,
                            value = 30
                        ),
                        checkboxInput(
                            inputId = "chckBxLg",
                            label = "Log scale",
                            value = FALSE
                        )
                        ,
                        actionButton("btnUpdate", "Update")
                    ),
                    mainPanel(textOutput("msgTxt"),
                              plotOutput("distPlot"))
                ))

# Define server logic required to draw a histogram
server <- function(input, output) {
    # Create placeholder object for msg
    msgUpdateText <- c("")

    # Insert update message text upon change to UI elements
    observeEvent(eventExpr = {
        input$bins
        input$chckBxLg
    },
    handlerExpr = {
        # This message should only show after interaction with the UI
        isolate(msgUpdateText <<-
                    c("You have clicked something, update the chart"))
    })

    # Render text
    output$msgTxt <- renderText(msgUpdateText)

    output$distPlot <- renderPlot({
        input$btnUpdate
        isolate({
            x    <- faithful[, 2]
            if (input$chckBxLg) {
                x <- log(x)
            }
            bins <-
                seq(min(x), max(x), length.out = input$bins + 1)

            # Also delete the text message
            msgUpdateText <<- c("")
        })

        hist(x,
             breaks = bins,
             col = 'darkgray',
             border = 'white')
    })
}

shinyApp(ui = ui, server = server)

问题

讯息:

You have clicked something, update the chart

应该只在用户与 UI 交互之后只出现，在之后消失>actionButton 被按下，而不是消息永久可见。

---

旁注

所提供的解决方案应该可以跨多个 UI 元素进行扩展。所提供的不工作示例 try catch 对两个 UI 元素的更改:

observeEvent(eventExpr = {
    input$bins      # Element 1
    input$chckBxLg  # Element 2
},
handlerExpr = {
    # This message should only show after interaction with the UI
    isolate(msgUpdateText <<-
                c("You have clicked something, update the chart"))
})

我正在努力使代码能够容纳大量的元素，在线

observeEvent(eventExpr = {
    input$bins      # Element 1
    input$chckBxLg  # Element 2
    input$title     # Element 3
    input$n         # Element n
    ...             ...
},
handlerExpr = {
    # User interacted with any of the UI elements listed above
    # Update text message to be displayed in the app
})

Answer 1

我想我已经达到了预期的结果。我已将必要的逻辑带入 3 个 observeEvent 调用中。第一个观察任何输入的变化并将变量设置为 TRUE。第二个观察更新按钮并将变量设置为 FALSE。第三个观察输入和更新按钮并根据变量呈现警告消息(如果它是 TRUE 则打印，否则它是空的)。

我发现的唯一问题是，此时它开始显示警告消息，但我无法弄清楚原因。

最终代码:

library(shiny)

ui <- fluidPage(titlePanel("Reactive UI"),
                sidebarLayout(
                  sidebarPanel(
                    # Reactive text should appear upon any change here
                    sliderInput(
                      "bins",
                      "Number of bins:",
                      min = 1,
                      max = 50,
                      value = 30
                    ),
                    checkboxInput(
                      inputId = "chckBxLg",
                      label = "Log scale",
                      value = FALSE
                    )
                    ,
                    actionButton("btnUpdate", "Update")
                  ),
                  mainPanel(uiOutput("msgui"),
                            plotOutput("distPlot"))
                ))

# Define server logic required to draw a histogram
server <- function(input, output) {
  # Initialize the value to check if a change happened
  Changebool <<- FALSE

  observeEvent(eventExpr = { #When an input is changed
    input$bins
    input$chckBxLg
  },
  handlerExpr = {  # Change the changebool to TRUE
    Changebool <<- TRUE
  }
  )

  observeEvent(eventExpr = { #When the update button is pressed
    input$btnUpdate
  },
  handlerExpr = {  # Change the changebool to FALSE
    Changebool <<- FALSE
  }
  )

  observeEvent({input$btnUpdate # If any of the inputs change or the update button is pressed
    input$bins
    input$chckBxLg},
               {  # Recreate the message-ui
                 output$msgui <- renderUI({
                   if (Changebool) {  # if a change has happened since last update
                     textOutput("msgTxt")  #Output text
                   } else {  #otherwise
                       #Output nothing
                   } 
                 })
               })

  # Render text
  output$msgTxt <- renderText("You have clicked something, update the chart")

  output$distPlot <- renderPlot({
    input$btnUpdate
    isolate({
      x    <- faithful[, 2]
      if (input$chckBxLg) {
        x <- log(x)
      }
      bins <-
        seq(min(x), max(x), length.out = input$bins + 1)
    })

    hist(x,
         breaks = bins,
         col = 'darkgray',
         border = 'white')
  })
}

shinyApp(ui = ui, server = server)

我必须承认我在这个问题上来回摆弄了很长一段时间，所以如果你发现代码中有任何奇怪的地方，请随时发表评论