Shiny: calculate cumsum based on dygraphs' RangeSelector

前端 未结 2 1784
慢半拍i
慢半拍i 2021-01-25 04:47

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 th

相关标签:
2条回答
  • 2021-01-25 05:16

    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)
    

    0 讨论(0)
  • 2021-01-25 05:40

    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().

    0 讨论(0)
提交回复
热议问题