R闪亮：将绘图重置为默认状态

Question

这是对我的问题here 的跟进。

当我启动闪亮的应用程序时，我有一个显示的图，然后我想运行一些代码来“动画”一些数据采样。

我想实现一个重置/清除按钮以将绘图重置为其原始状态（即，就像我刚刚再次启动应用程序一样）。有什么想法吗？

我当前代码的工作示例：

library(shiny)
library(ggplot2)

invalidateLaterNew <- function (millis, session = getDefaultReactiveDomain(), update = TRUE) 
{
    if(update){
        ctx <- shiny:::.getReactiveEnvironment()$currentContext()
        shiny:::timerCallbacks$schedule(millis, function() {
            if (!is.null(session) && session$isClosed()) {
                return(invisible())
            }
            ctx$invalidate()
        })
        invisible()
    }
}

unlockBinding("invalidateLater", as.environment("package:shiny"))
assign("invalidateLater", invalidateLaterNew, "package:shiny")

data <- data.frame(ID=1:60, 
                   x=sort(runif(n = 60)), 
                   y=sort(runif(n = 60)+rnorm(60)))

ui <- fluidPage(
    sidebarPanel(
        sliderInput("n",
                    "Number of samples:",
                    min = 10,
                    max = nrow(data),
                    value = 20),

        sliderInput("surveys",
                    "Number of surveys:",
                    min = 1,
                    max = 10,
                    value = 5),

        actionButton("button", "Go!"),
        actionButton("reset", "Reset")
    ),
    # Show the plot
    mainPanel(
        plotOutput("plot1")
    )
)

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

    plot1 <- NULL
    count <- 0

    output$plot1 <- renderPlot({
        plot1 <<- ggplot(data, aes(x=x, y=y)) + geom_point(colour="red") + theme_bw()
        plot1 <<- plot1 + geom_vline(xintercept = mean(data$x), size=1.1, colour="red")
        plot1
    })

    observeEvent(input$button,{

        count <<- 0
        output$plot1 <- renderPlot({

            count <<- count+1
            invalidateLater(500, session,  count < input$surveys)
            data$sampled <- "red"
            sample.rows <- sample(data$ID, input$n)
            data$sampled[sample.rows] <- "green"

            plot1 <<- plot1 + geom_point(x=data$x, y=data$y, colour=data$sampled, size=2)

            sample.mean.x <- mean(data$x[sample.rows])

            plot1 <<- plot1 + geom_vline(xintercept = sample.mean.x, colour="green")

            plot1

        })
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

我尝试使用重置按钮输入将第一个 renderPlot({...}) 呼叫包装在 observeEvent 呼叫中，但没有好处。我还尝试创建第三个renderPlot({...}) 调用，它有一个observeEvent。 我什至尝试将“原始”plot1 复制到第二个变量并在重置按钮上调用它，但没有运气。

Answer 1

根据我在您之前的问题中的评论，我通过在 observeEvent 中添加 plot1<<-NULL 来完成更改，然后再次渲染原始图。

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

    plot1 <- NULL
    count <- 0

    output$plot1 <- renderPlot({
      plot1 <<- ggplot(data, aes(x=x, y=y)) + geom_point(colour="red") + theme_bw()
      plot1 <<- plot1 + geom_vline(xintercept = mean(data$x), size=1.1, colour="red")
      plot1
    })

    observeEvent(input$button,{
      plot1 <<- NULL

      output$plot1 <- renderPlot({
        plot1 <<- ggplot(data, aes(x=x, y=y)) + geom_point(colour="red") + theme_bw()
        plot1 <<- plot1 + geom_vline(xintercept = mean(data$x), size=1.1, colour="red")
        plot1
      })

      count <<- 0
      output$plot1 <- renderPlot({

        count <<- count+1
        invalidateLater(500, session,  count < input$surveys)
        data$sampled <- "red"
        sample.rows <- sample(data$ID, input$n)
        data$sampled[sample.rows] <- "green"

        plot1 <<- plot1 + geom_point(x=data$x, y=data$y, colour=data$sampled, size=2)

        sample.mean.x <- mean(data$x[sample.rows])

        plot1 <<- plot1 + geom_vline(xintercept = sample.mean.x, colour="green")

        plot1

      })
    })
  }

在上述情况下，您不需要重置按钮。如果您想要一个重置按钮，您可以将plot<<-NULL 和renderPlot 放在重置按钮的observeEvent 内。像这样的：

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

    plot1 <- NULL
    count <- 0

    output$plot1 <- renderPlot({
      plot1 <<- ggplot(data, aes(x=x, y=y)) + geom_point(colour="red") + theme_bw()
      plot1 <<- plot1 + geom_vline(xintercept = mean(data$x), size=1.1, colour="red")
      plot1
    })

    observeEvent(input$button,{

      count <<- 0
      output$plot1 <- renderPlot({

        count <<- count+1
        invalidateLater(500, session,  count < input$surveys)
        data$sampled <- "red"
        sample.rows <- sample(data$ID, input$n)
        data$sampled[sample.rows] <- "green"

        plot1 <<- plot1 + geom_point(x=data$x, y=data$y, colour=data$sampled, size=2)

        sample.mean.x <- mean(data$x[sample.rows])

        plot1 <<- plot1 + geom_vline(xintercept = sample.mean.x, colour="green")

        plot1

      })
    })


    observeEvent(input$reset,{

      plot1<<- NULL


      output$plot1 <- renderPlot({
        plot1 <<- ggplot(data, aes(x=x, y=y)) + geom_point(colour="red") + theme_bw()
        plot1 <<- plot1 + geom_vline(xintercept = mean(data$x), size=1.1, colour="red")
        plot1
      })


    })

  }

希望这会有所帮助！