结合反应性和事件反应性来生成绘图

Posted 2023-03-24

【中文标题】结合反应性和事件反应性来生成绘图

【英文标题】：Combination of reactive and eventReactive for generating a plot

【发布时间】：2019-10-11 13:23:42

【问题描述】：

概述： 我正在使用响应式组件根据用户输入动态更新数据集。这没有任何问题。

附加要求：我只想在单击按钮时为绘图着色。 当前设置：单击“颜色”按钮后，即使更改数据集，颜色也会保留。

我在 observeEvent 块中定义了相同的输出元素来覆盖 server.xml 中定义的默认元素。但是，此覆盖是永久性的。

library(shiny)
shinyApp(ui = fluidPage(
  sidebarPanel(
    selectInput(inputId = "dropdown", label = "Select data set:",
                choices = c("iris", "mtcars"), selected = "iris")
  ),

  mainPanel(fluidPage(
    fluidRow(plotOutput("plot"),
             actionButton("color", "Color"))
  ))
), server = function(input, output) 
  get_data <- reactive(
    if(input$dropdown == "iris") 
      return(list(dat = iris, x = "Sepal.Length", color = "Species"))
     else 
      return(list(dat = mtcars, x = "mpg", color = "cyl"))
    
  )
  output$plot <- renderPlot(
    dat <- get_data()
    return(plot(dat$dat[, dat$x]))
  )

  observeEvent(input$color, 
    output$plot <- renderPlot(
      dat <- get_data()
      return(plot(dat$dat[, dat$x], col = dat$dat[, dat$color]))
    )
  )
)

实际结果： 即使我更改数据集，每次单击“颜色”按钮时都会出现颜色。 预期结果： 单击当前数据集的“颜色”后应显示颜色。一旦我更改数据集，它就不应该出现。只有当我再次单击“颜色”按钮时它才会重新出现。

【参考方案1】：

您似乎想要跟踪状态。您不能真正“取消单击”按钮，因此最好只存储一个反应值来指示您是否需要颜色，并且您可以在数据集更改时重置它。这是这样一个服务器函数

function(input, output) 

  showColor <- reactiveVal(FALSE)

  get_data <- reactive(
    if(input$dropdown == "iris") 
      return(list(dat = iris, x = "Sepal.Length", color = "Species"))
     else 
      return(list(dat = mtcars, x = "mpg", color = "cyl"))
    
  )
  output$plot <- renderPlot(
    dat <- get_data()
    if (showColor()) 
      plot(dat$dat[, dat$x], col = dat$dat[, dat$color])
     else 
      plot(dat$dat[, dat$x])
    
  )
  observeEvent(input$dropdown, 
    showColor(FALSE)
  )
  observeEvent(input$color, 
    showColor(TRUE)
  )

您看到我们添加了showColor <- reactiveVal(FALSE) 部分，因此默认情况下它不会显示颜色，并在下拉列表更改时将其重置为FALSE。当您按下“颜色”按钮时，我们将其设置为TRUE。

【讨论】：

谢谢你，这行得通！ @alko989 的回答提出了一个更一般的情况，因为我的高级应用程序的输出是 API 调用的结果，而不仅仅是一个值。

【参考方案2】：

你可以显式观察input$dropdown触发的事件：

function(input, output) 
  get_data <- reactive(
    if(input$dropdown == "iris") 
      return(list(dat = iris, x = "Sepal.Length", color = "Species"))
     else 
      return(list(dat = mtcars, x = "mpg", color = "cyl"))
    
  )
  observeEvent(input$dropdown, 
    output$plot <- renderPlot(
      dat <- get_data()
      return(plot(dat$dat[, dat$x]))
    )  
  )

  observeEvent(input$color, 
    output$plot <- renderPlot(
      dat <- get_data()
      return(plot(dat$dat[, dat$x], col = dat$dat[, dat$color]))
    )
  )

【讨论】：

谢谢！这是对@MrFlick 答案的一个很好的概括，因为可以使用不同的返回类型。