更新 R Shiny 中的图形反应

Update Graph in R Shiny react

我想了解为什么图表在从下面的代码生成的 RShiny 应用程序中没有更新。

我尝试做的事情:

    library(shiny)
library(ggplot2)

# Design the interface
ui <-  fluidPage(titlePanel("Population vs sample"),

                 sidebarLayout(
                   # Function to determine the layout
                   sidebarPanel(
                     sliderInput(
                       'shape1',
                       label = 'Population shape 1:',
                       min = 1,
                       max = 9,
                       value = 2 ,
                       step = 1
                     ),
                     sliderInput(
                       'shape2',
                       label = 'Population shape 2:',
                       min = 1,
                       max = 9,
                       value = 2 ,
                       step = 1
                     ),

                     textInput("n_data", label = "Sample size:",
                               value = '25'),

                     textInput("e_samples", label = "number of samples:",
                               value = '5'),

                     actionButton("RerunButton", "New sample", icon("play"))
                   ),

                   mainPanel(plotOutput('Sample'))
                 ))

# Set up the server
server <- function(input, output) {
  set.seed(1234)
  xvals <- seq(.001, .999, by = 0.001)

  # Define reactive values
  avgs <- reactiveVal(vector(mode = "list", length = 1))
  vals <- reactiveVal(0)
  s <- reactiveVal()
  sample_plot <- reactiveVal()

# This is where I hope to generate a new graph every second.
  observe({
    invalidateLater(1000)
    cat(paste('vals', vals(), '\n'))
    cat(paste('avgs', avgs(), '\n'))
    if (vals() < input$e_samples) {
      s(data.frame(
        d = rbeta(
          n = input$n_data,
          shape1 = as.numeric(input$shape1),
          shape2 = as.numeric(input$shape2)
        )
      ))
      temp <- s()
      vals(vals() + 1)
      averages <- avgs()
      averages[vals()] <- mean(temp$d)
      avgs(averages)
      sample_plot(
        ggplot() +
          geom_histogram(
            data = temp,
            aes(x = d),
            binwidth = 0.1,
            fill = 'white',
            col = 'black'
          ) +
          geom_vline(xintercept = mean(temp$d)) +
          xlim(0, 1) +
          xlab('observation value') +
          ylab('count')
      )
    }
  })



  output$Sample <- renderPlot({
    sample_plot()
  })

  observeEvent(input$RerunButton, {
    vals(0)
  })
  observeEvent(input$RerunButton, {
    avgs(vector(mode = "list", length = 1))
  })
}

shinyApp(ui = ui, server = server)

上面的代码只更新图表一次。为什么?

你所有不断变化的 reactiveValues 都会立即反复触发你的 observe。这种情况连续发生五次,在 1000 毫秒过去之前。为防止这种情况发生,您需要为 reactiveValues 使用 isolate。看看这是否给出了正确的行为:

# Set up the server
server <- function(input, output, session) {
  set.seed(1234)
  xvals <- seq(.001, .999, by = 0.001)

  # Define reactive values
  avgs <- reactiveVal(vector(mode = "list", length = 1))
  vals <- reactiveVal(0)
  s <- reactiveVal()
  sample_plot <- reactiveVal()

  # This is where I hope to generate a new graph every second.
  observe({
    invalidateLater(1000, session)

    #cat(paste('vals', vals(), '\n'))
    #cat(paste('avgs', avgs(), '\n'))

    if (isolate(vals()) < input$e_samples) {
      s(data.frame(
        d = rbeta(
          n = input$n_data,
          shape1 = as.numeric(input$shape1),
          shape2 = as.numeric(input$shape2)
        )
      ))
      temp <- s()
      isolate(vals(vals() + 1))
      averages <- isolate(avgs())
      averages[vals()] <- mean(temp$d)
      avgs(averages)
    }
  })

  sample_plot <- reactive({
    ggplot() +
      geom_histogram(
        data = s(),
        aes(x = d),
        binwidth = 0.1,
        fill = 'white',
        col = 'black'
      ) +
      geom_vline(xintercept = mean(s()$d)) +
      xlim(0, 1) +
      xlab('observation value') +
      ylab('count')
  })

  output$Sample <- renderPlot({
    sample_plot()
  })

  observeEvent(input$RerunButton, {
    vals(0)
  })

  observeEvent(input$RerunButton, {
    avgs(vector(mode = "list", length = 1))
  })
}