Question

这是我的问题here的后续跟进。

当我启动闪亮的应用程序时，我会显示一个情节，然后我想运行一些代码，这些代码会动画＆＃34;动画＆＃34;从数据中抽取一些。

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

我当前代码的工作示例：

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。我甚至试过复制＆＃34;原版＆＃34; plot1到第二个变量并在重置按钮上回忆一下，但没有运气。

Answer 1

根据我在上一个问题中的评论，我通过在plot1<<-NULL中添加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,{
      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
      })


    })

  }

希望这有帮助！

R有光泽：将绘图重置为默认状态

1 个答案: