首页 文章

ShinyApp，动态文本出现在多个UI元素的任何变化上

提问于
浏览 次
3

我有兴趣开发一个以下列方式起作用的Shiny App：

  • 在对用户界面元素数量进行任何更改后更新图表 . 这是通过actionButton / isolate 构造完成的 .

  • 显示警告文本，提示用户单击 Update 按钮 . Outstanding.

  • 按下 Update 按钮后删除警告文本 . Outstanding.

示例

方法

  • 通过rstudio提供的示例中的一个示例，以下示例提供了对修改直方图的两个功能的访问 .

  • 直方图在 Update 按钮单击时更新 .

  • 与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)

问题

消息：

您点击了某些内容，更新了图表

只有在用户与UI交互后才会显示 only ，并且在按下 actionButton 后 disappear ，而该消息将永久显示 .

App preview

附注

提供的解决方案应该可以跨多个UI元素进行扩展 . 提供的，不工作的示例尝试捕获对两个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
})
r shiny reactive-programming observable shinyapps

1 回答

  • 2

    我想我已经将必要的逻辑带入了3 observeEvent 次调用 . 第一个观察到任何输入变化并将变量设置为 TRUE . 第二个观察updatebutton并将变量设置为 FALSE . 第三个观察输入和updatebutton并根据变量呈现警告消息（如果它打印 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)

    我必须承认我在这方面来回摆弄相当多，所以如果你发现代码中有任何奇怪的东西可以随意发表评论

    回复于

相关问题