Shiny: рассчитать сумму на основе RangeSelector на графике

Question

Я создаю блестящее приложение, в котором я хочу построить набор данных, в котором одна из переменных является суммой другой переменной.Последнее необходимо пересчитывать каждый раз, когда изменяется начальная дата dygraphs 'dyRangeSelector.Ниже приведен базовый код без cumsum расчетов.Закомментированный код - это то, что я пытался, но безуспешно

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)

ОБНОВЛЕНИЕ

Я изменил ответ @Pork Chop, чтобы иметь возможность отображать совокупные значения с другими метриками на одном графике, но я даже не могу отобразить график сейчас:

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

Проблема с вашим обновленным кодом в том, что вы не сохранили информацию о дате.Также, как только вы начинаете рендерить сюжет, основанный на изменении самого графика (рекурсия), он становится немного сложнее.Вы должны убедиться, что повторный рендеринг графика не вызовет рендеринг снова, иначе вы окажетесь в цикле.Вот почему я установил retainDateWindow = TRUE.Кроме того, вы не хотите, чтобы график повторно визуализировался сразу после первого изменения ползунка, поэтому я отменил подданные.

Тем не менее, при использовании графиков у вас все еще остается проблема, что при добавлении cumsumкак серия, ваш график для dyRangeSelector изменяется (максимум y всех серий).Пожалуйста, смотрите следующий код:

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)

Так же, как упоминал @PorkChop, я бы порекомендовал несколько выходов для этого сценария.Кроме того, я бы посоветовал взглянуть на library(plotly), и это event_data () .

Answer 2

Это должно сделать работу, я думаю, что чище иметь отдельные выходы для вашей приборной панели

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)