R Shiny : refreshing/overriding actionButton() output

Question

我正在努力适应R Shiny: automatically refreshing a main panel without using a refresh button一个新的最小工作示例:

ui <- fluidPage(

  pageWithSidebar(
    headerPanel("actionButton test"),
    sidebarPanel(
      numericInput("n", "N:", min = 0, max = 100, value = 50),
      br(),
      actionButton("goButton", "Go!"),
      p("Click the button to update the value displayed in the main panel."),
      actionButton("newButton", "New Button"),
      actionButton("newButton2", "Another New Button")
    ),
    mainPanel(
      verbatimTextOutput("nText"),
      textOutput("some_text_description"),
      plotOutput("some_plot")
    )
  )

)


server <- function(input, output, session) {

  # builds a reactive expression that only invalidates 
  # when the value of input$goButton becomes out of date 
  # (i.e., when the button is pressed)
  ntext <- eventReactive(input$goButton, {
    input$n
  })

  output$nText <- renderText({
    ntext()
  })


  # Prep some text for output
  output$some_text_description <- renderText({ 
    if (input$newButton == 0) {return(NULL)}
    else { 
      "Lorem ipsum dolorom." 
    }
  })

  # Prep some figure for output
  # Simple Bar Plot 
  output$some_plot <- renderPlot({ 
    if (input$newButton2 == 0) {return(NULL)}
    else { 
      counts <- table(mtcars$gear)
      barplot(counts, main="Car Distribution", xlab="Number of Gears")
    }
  })

}



shinyApp(ui = ui, server = server)

在上面的代码中，我有三个 actionButton 命令，一个生成绘图，一个生成文本输出，一个生成数字(作为逐字文本输出)。当您点击每个按钮时，新的输出会与之前生成的输出(从您按下的最后一个按钮开始)一起出现。

无需实现手动清除所有内容的刷新按钮，我如何让每个 actionButton 自动覆盖(即删除)其他的输出，而不是它们全部堆叠在一起主面板。我的理解是我需要使用 observeEvent、NULL 和 reactiveValues 的某种组合，但到目前为止我的尝试没有成功。

Answer 1

您可以为此使用 renderUI()。

  output$all <- renderUI({
    global$out
  })

在全局 reactiveValue global$out 中，您可以存储要显示的 ui 元素。 (最初它应该是空的，因此 NULL)。

  global <- reactiveValues(out = NULL)

然后监听按钮中的点击并相应地更新 global$out。

  observeEvent(input$goButton, {
    global$out <- verbatimTextOutput("nText")
  })

  observeEvent(input$newButton, {
    global$out <- textOutput("some_text_description")
  })

  observeEvent(input$newButton2, {
    global$out <- plotOutput("some_plot")
  })

完整的应用程序将显示:

library(shiny)
ui <- fluidPage(

  pageWithSidebar(
    headerPanel("actionButton test"),
    sidebarPanel(
      numericInput("n", "N:", min = 0, max = 100, value = 50),
      br(),
      actionButton("goButton", "Go!"),
      p("Click the button to update the value displayed in the main panel."),
      actionButton("newButton", "New Button"),
      actionButton("newButton2", "Another New Button")
    ),
    mainPanel(
      uiOutput("all")
    )
  )

)


server <- function(input, output, session) {

  global <- reactiveValues(out = NULL)

  observeEvent(input$goButton, {
    global$out <- verbatimTextOutput("nText")
  })

  observeEvent(input$newButton, {
    global$out <- textOutput("some_text_description")
  })

  observeEvent(input$newButton2, {
    global$out <- plotOutput("some_plot")
  })

  output$all <- renderUI({
    global$out
  })

  output$nText <- renderText({
    input$n
  })

  output$some_text_description <- renderText({ 
      "Lorem ipsum dolorom."
  })

  # Simple Bar Plot 
  output$some_plot <- renderPlot({ 
    counts <- table(mtcars$gear)
    barplot(counts, main="Car Distribution", xlab="Number of Gears")
  })

}



shinyApp(ui = ui, server = server)