Question

我正在尝试使用Shiny创建一个显示采样方式动画的应用。类似于here显示的示例。

这里有一些最小的代码，只显示了我遇到问题的部分。这不是我使用的数据，而是可重复的示例数据集。

library(shiny)
library(ggplot2)

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 = 100,
                    value = 20),

        sliderInput("surveys",
                    "Number of surveys:",
                    min = 10,
                    max = 100,
                    value = 20),

        checkboxInput("replacement", 
                      "Sample with replacement?"),

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

server <- function(input, output) {
    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

        for(i in 1:20){
            data$sampled <- "red"
            sample.rows <- sample(data$ID, 20, replace = F)
            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")

            print(plot1)
            Sys.sleep(1.5)
        }
    })
}

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

renderPlot({ ... })中的部分完全按照我想要的方式粘贴到控制台中，但是如何在Shiny中实现这一点？理想情况下，我还希望首先显示情节，然后在点击actionButton时开始动画（绿色条）。

谢谢！

Answer 1

您可以使用reactiveTimer来执行此操作。我修改了代码的服务器部分。在下面的代码中，我将计时器设置为两秒钟，以便绘图每两秒更新一次。

  server <- function(input, output) {

    autoInvalidate <- reactiveTimer(2000)
    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
    })

    observeEvent(input$button,{

      output$plot1 <- renderPlot({
        autoInvalidate()
        data$sampled <- "red"
        sample.rows <- sample(data$ID, 20, replace = F)
        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

      })
    })
  }

<强> [编辑] ：

如你所知，循环只运行了20次，我在this链接的答案的帮助下修改了代码，这样反应计时器只运行到计数为20.这是代码您需要从链接添加：

  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")

以下是它的服务器代码：

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

count = 0
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
  })

observeEvent(input$button,{
 count <<- 0
  output$plot1 <- renderPlot({

    count <<- count+1
    invalidateLater(1500, session,  count < 20)
    data$sampled <- "red"
    sample.rows <- sample(data$ID, 20, replace = F)
    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

  })
})


 }

R Shiny：通过循环添加绘图

1 个答案: