Shiny: calculate cumsum based on dygraphs' RangeSelector - shiny

Question

I'm building a shiny app where I want to plot a dataset with one of the variables being a cumulative sum of another variable. The latter needs to be re-calculated every time the start date of dygraphs' dyRangeSelector changes. Below is a basic code without cumsum calculations. Commented out code is what I tried, with no success.
library(shinydashboard)
library(stringr)
library(zoo)
library(dplyr)
library(dygraphs)
ui <-dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
uiOutput("Ui1")
)
)
server <- function(input, output, session) {
output$Ui1 <- renderUI({
# date range observer
# values <- reactiveValues()
#
# observeEvent(input$plot1_date_window, {
# from <- as.Date(str_sub(input$plot1_date_window[[1]], 1, 10))
# })
## dygraphs plot
output$plot1 <- renderDygraph({
m_df <- data.frame(date=as.Date(zoo::as.yearmon(time(mdeaths))), Y=as.matrix(mdeaths))
# input_data <- m_df %>%
# filter(date >= values$from) %>%
# mutate(cumY = cumsum(Y))
input_xts <- xts(select(m_df, -date),
order.by = m_df$date)
#select(input_data, -date),
#order.by = input_data$date)
p <- dygraph(input_xts) %>%
dyRangeSelector()
p
})
## outputs
dygraphOutput('plot1')
})
}
shinyApp(ui, server)
UPDATE
I modified #Pork Chop's answer to be able to plot the cumulative values with other metrics on one graph, but I'm not even able to display the plot now:
library(xts)
library(shiny)
library(shinydashboard)
library(dygraphs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
dygraphOutput('plot1'),
textOutput("cumsum1")
)
)
server <- function(input, output, session) {
m_df <- data.frame(date=as.Date(zoo::as.yearmon(time(mdeaths))), Y=as.matrix(mdeaths))
subdata <- reactive({
cumsum(m_df$Y[m_df$date >= as.Date(input$plot1_date_window[1]) & m_df$date <= as.Date(input$plot1_date_window[2])])
})
output$plot1 <- renderDygraph({
req(input$plot1_date_window)
input_xts <- xts(select(m_df, -date), order.by = m_df$date)
subdata_xts <- xts(select(subdata(), - date), order.by = subdata()$date)
final_xts <- cbind(input_xts, subdata_xts)
dygraph(final_xts) %>%
dyRangeSelector()
})
output$cumsum1 <- renderText({
req(input$plot1_date_window)
subdata <- cumsum(m_df$Y[m_df$date >= as.Date(input$plot1_date_window[1]) & m_df$date <= as.Date(input$plot1_date_window[2])])
subdata
})
}
shinyApp(ui, server)

Answer 1

The problem with your updated code is, that you didn't keep the date information. Also once you start rendering a plot based on a change of the plot itself (recursion) it gets a little tricky. You have to make sure that re-rendering the plot doesn't trigger the rendering again or you'll end up in a loop. That's why I set retainDateWindow = TRUE. Besides that you don't want the plot to re-render right away after the first change of the slider that's why I debounced the subdata.
Nevertheless, using dygraphs you still have the problem, that when you add cumsum as a series your plot for dyRangeSelector is changed (y maximum of all series). Please see the following code:
library(xts)
library(shiny)
library(shinydashboard)
library(dygraphs)
library(dplyr)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
dygraphOutput('plot1')
)
)
server <- function(input, output, session) {
m_df <- data.frame(date=as.Date(zoo::as.yearmon(time(mdeaths))), Y=as.matrix(mdeaths))
subdata <- reactive({
if(!is.null(input$plot1_date_window)){
subdata <- m_df[m_df$date >= as.Date(input$plot1_date_window[1]) & m_df$date <= as.Date(input$plot1_date_window[2]), ]
subdata$cumsum <- cumsum(subdata$Y)
subdata$Y <- NULL
} else {
subdata <- NULL
}
return(subdata)
})
subdata_d <- subdata %>% debounce(100)
output$plot1 <- renderDygraph({
input_xts <- xts(select(m_df, -date), order.by = m_df$date)
if(is.null(subdata_d())){
final_xts <- input_xts
} else {
subdata_xts <- xts(select(subdata_d(), - date), order.by = subdata_d()$date)
final_xts <- cbind(input_xts, subdata_xts)
}
p <- dygraph(final_xts) %>% dySeries(name="Y") %>%
dyRangeSelector(retainDateWindow = TRUE)
if("cumsum" %in% names(final_xts)){
p <- dySeries(p, name="cumsum", axis = "y2")
}
p
})
}
shinyApp(ui, server)
Just as #PorkChop mentioned I'd recommend multiple outputs for this scenario. Furthermore, I'd suggest to have a look at library(plotly) and it's event_data().

Answer 2

This should do the job, I think it is cleaner to have separate outputs for your dashboard
library(xts)
library(shiny)
library(shinydashboard)
library(dygraphs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
dygraphOutput('plot1'),
textOutput("cumsum1")
)
)
server <- function(input, output, session) {
m_df <- data.frame(date=as.Date(zoo::as.yearmon(time(mdeaths))), Y=as.matrix(mdeaths))
output$plot1 <- renderDygraph({
input_xts <- xts(select(m_df, -date), order.by = m_df$date)
dygraph(input_xts) %>%
dyRangeSelector()
})
output$cumsum1 <- renderText({
req(input$plot1_date_window)
subdata <- cumsum(m_df$Y[m_df$date >= as.Date(input$plot1_date_window[1]) & m_df$date <= as.Date(input$plot1_date_window[2])])
subdata
})
}
shinyApp(ui, server)