R Shiny：音标系列对`date_window`的反应

Question

In this miniapp, the goal is to display raw series and it's average over the selected range:

library(dygraphs)
library(datasets)

server <- function(input, output) {

  reacteddata <- reactive({

    dt = cbind(as.xts(ldeaths),ave=NA)
    if (!is.null(input$dygraph_date_window)){
      start=strftime(input$dygraph_date_window[[1]])
      end=strftime(input$dygraph_date_window[[2]])
      subset = window(as.xts(ldeaths), start=start, end=end)
      ave = rep(mean(subset), length(subset))
      dt[index(as.xts(subset)),"ave"] = ave
      dt = dt[index(as.xts(subset))]
    } else {
      dt[,"ave"] = rep(mean(ldeaths), length(ldeaths))
    }
    dt
  })

  output$dygraph <- renderDygraph({
    dygraph(reacteddata(), main = "Predicted Deaths/Month")
  })
}

ui <- fluidPage(

  sidebarLayout(
    mainPanel(
      dygraphOutput("dygraph")
    )
  )
)

shinyApp(ui = ui, server = server)

It works, even redraws the average line on the zoom ins (using mouse to select zoom date range):

However the catch is that it loses data on each redraw, hence it is impossible to zoom out. Any ideas how to rework it?

Answer 1

It helps to retain full dt dataset outside reactive element and update the ave (average) column based on selected reactive dygraph_date_window . Also, retainDateWindow needs to be set to TRUE .

library(dygraphs); library(shiny); library(datasets); library(xts)

server <- function(input, output) {
  dt = setNames(as.xts(ldeaths), "ldeaths")
  dt = cbind(dt,ave=NA)

  reacteddata <- reactive({
    if (!is.null(input$dygraph_date_window)){
      start=strftime(input$dygraph_date_window[[1]])
      end=strftime(input$dygraph_date_window[[2]])
      subset = window(dt, start=start, end=end)
      ave = rep(mean(subset$ldeaths), nrow(subset))
      dt[index(as.xts(subset)),"ave"] = ave
    } else {
      dt[,"ave"] = rep(mean(ldeaths), length(ldeaths))
    }
    dt
  })

  output$dygraph <- renderDygraph({
    dygraph(reacteddata(), main = "Predicted Deaths/Month") %>% 
      dyOptions(retainDateWindow = TRUE)
  })
}

ui <- fluidPage(
      dygraphOutput("dygraph")
)

shinyApp(ui = ui, server = server)