R Shiny динамически редактирует интервал таймера reactiveTimer - PullRequest
Новая
       29

R Shiny динамически редактирует интервал таймера reactiveTimer

1 голос
/ 03 августа 2020

Я пытаюсь создать блестящую панель инструментов R, на которой есть кнопки воспроизведения и паузы для обновления отображения данных графика в течение определенного периода времени. Для этого я использовал reactiveTimer, но он не позволяет мне динамически редактировать интервал reactiveTimer. 

Error in .getReactiveEnvironment()$currentContext() : 
  Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)

Мой код попытки: 

library(shiny)
library(ggplot2)
library(tidyr)

input.df <- read.csv(file = 'InputData.csv', header = TRUE, sep=",")

ui<-fluidPage(
  titlePanel("Auckland Volcanic Simulation"),
  hr(style="border-color: grey;"),
  sidebarLayout(
    # panel with all inputs
    sidebarPanel(
      fluidRow(
        column(7,actionButton("stop","Pause")),
        column(5,actionButton("play","Play"))
      ),
      fluidRow(
        column(7,actionButton("skip","Skip")),
        column(3,actionButton("reset","Reset"))
      )
    ),
    # plot panel
    mainPanel(
      # visual data on same row
      fluidRow(
        span(textOutput("Date"), style="font-size: 24px;font-style: italic;")
      ),
       fluidRow(
         column(12,plotOutput('defGraph'))
       )
    )
  )
  
)

server<-function(input,output){

  control<-reactiveValues() # reactive to store all reactive variables
  control$resetindicator<-0   # used to change button labels
  control$count<-0   # day number in sequence
  control$min<-0
  control$max<-0
  control$timer<-Inf

  forward<-function(){
    print("in forward")
    control$resetindicator<-1 # change button label

    step <- 12
    if (step >= control$count) {
      min <- 0
      max <- control$count
    } else {
      min <- control$count - step
      max <- control$count
    }
    control$min <- min
    control$max <- max
    control$count<-control$count+1
  }

  observeEvent(input$skip,{
    forward()
  })

  session<-reactiveValues()
  session$timer<-reactiveTimer(intervalMs = control$timer, session = getDefaultReactiveDomain())

  observeEvent(input$play,{
    print("play")
    control$timer<-1000
    #session$timer<-reactiveTimer(intervalMs = 1000, session = getDefaultReactiveDomain())# Time interval
    observeEvent(session$timer(),{
      print("calling forward")
      forward()
    })
  })

  observeEvent(input$stop,{
    print("stop")
    control$timer<-Inf
    #session$timer<-reactiveTimer(intervalMs = Inf, session = getDefaultReactiveDomain())
  })

  ## when reset button is pressed (set everything to original values, plus set seed)
  observeEvent(input$reset,{
    control$resetindicator<-0
    control$count= 0
  })

  # ## depth plot output
  output$DepthGraph <- renderPlot({
    eqdepthdata.df <- input.df[(input.df$DayTimeID <= control$max & input.df$DayTimeID >= control$min), ]
    ggplot(data.df, aes(x = DateTime, y = -1*AverageDepth_km)) + 
      geom_point() +
      scale_color_manual(values = c("darkorange")) +
      labs(title = "Average depth of earthquakes", x = "", y = "Depth (km)") +
      ylim(-40, 0) +
      theme_light() +
      theme(text = element_text(size = 14)) +
      theme(axis.text.x = element_text(angle = 45, hjust = 1))
  })
  
  ## visual data outputs
  output$Date<-renderText({
    paste("Date:", input.df$DateTime[input.df$DayTimeID == control$count-1])
  })

}

shinyApp(ui = ui, server = server)

Пример CSV: 

DayTimeID,Date,      Time,  DateTime,        AverageDepth_km
0,        20/08/20,  0:00,  20/08/20 0:00,   17
1,        20/08/20,  4:00,  20/08/20 4:00,   8
2,        20/08/20,  8:00,  20/08/20 8:00,   14
3,        20/08/20,  12:00, 20/08/20 12:00,  3
4,        20/08/20,  16:00, 20/08/20 16:00,  5
5,        20/08/20,  20:00, 20/08/20 20:00,  9

Я пытался обновить параметр для интервала, обновляя параметр. Я следовал представленному здесь коду https://nhsrcommunity.com/blog/animating-a-graph-over-time-in-shiny/, но если нажать play-> pause-> play, но временной интервал будет в два раза быстрее, как если бы я понимаю, что вы создали еще один reactiveTimer.

Любая помощь были бы признательны.

...