Обновить график в R Shiny React

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

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

  • Сгенерируйте выборку наблюдений n_data из бета-распределения с определенными параметрами формы.
  • Постройте гистограмму этого образца вместе с его средним значением.
  • Сделайте это e_samples раз и сохраните средние значения, показывайте обновленный график каждую секунду
  • Постройте гистограмму вектора с помощью e_samples means
    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)

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


r shiny shiny-reactivity shinyapps
person Community    schedule 14.03.2020    source источник

Ответы (1)


arrow_upward
0
arrow_downward

Все ваши reactiveValues, которые продолжают меняться, сразу же многократно запускают ваш observe. Это происходит пять раз подряд, задолго до истечения 1000 мсек. Чтобы этого не произошло, вам нужно будет использовать 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))
  })
}
person Ben    schedule 14.03.2020