组合反应式和事件反​​应式以生成图

时间:2019-05-25 02:06:03

标签: r shiny shiny-server shiny-reactivity shinyapps

概述: 我正在使用反应性组件根据用户输入动态更新数据集。这可以正常工作。

其他要求:我只想单击按钮即可为绘图着色。 当前设置:点击“颜色”按钮后,即使更改数据集,颜色仍然保留。

我在observeEvent块中定义了相同的输出元素,以覆盖服务器中定义的默认元素。但是,此替代是永久性的。

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

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

2 个答案:

答案 0 :(得分:2)

似乎您想跟踪状态。您不能真正地“取消”按钮,所以最好只存储一个反应性值以指示您是否想要颜色,并且可以在数据集更改时重置该值。这是一个服务器功能

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

答案 1 :(得分:1)

您可以显式观察由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]))
    })
  })
}