Обновление Графика в R Shiny реагирует

Question

Я хотел бы понять, почему график не обновляется в приложении RShiny, созданном из кода ниже.

Что я пытаюсь сделать:

• Создать образец n_data наблюдения из бета-распределения с определенными параметрами формы.
• Постройте гистограмму этого образца вместе со средним значением.
• Делайте это e_samples раз и сохраняйте средние значения, отображайте обновленный график каждую секунду
• Построить гистограмму вектора с помощью e_samples означает

    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)

Приведенный выше код обновляет график только один раз. Почему?

Answer 1

Все ваши reactiveValues, которые постоянно меняются, сразу же запускают ваш observe. Это происходит пять раз подряд, задолго до того, как пройдет 1000 мсек c. Чтобы этого не случилось, вам нужно использовать isolate для вашего reactiveValues. Посмотрите, дает ли это правильное поведение:

# 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))
  })
}