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) 

我已經試過包裝在一個observeEvent呼叫與復位按鈕輸入第一個renderPlot({...})電話，但沒有好。我也嘗試創建第三個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 
     }) 


    }) 

    } 

希望這有助於！