Shiny:根据 dygraphs 的 RangeSelector 计算 cumsum
Shiny: calculate cumsum based on dygraphs' RangeSelector
我正在构建一个闪亮的应用程序,我想在其中绘制一个数据集,其中一个变量是另一个变量的累积和。每次 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)
这应该可以完成工作,我认为为您的仪表板提供单独的输出更清晰
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)
更新后的代码存在问题,您没有保留日期信息。此外,一旦您开始根据绘图本身的变化(递归)渲染绘图,它就会变得有点棘手。您必须确保重新渲染绘图不会再次触发渲染,否则您将陷入循环。这就是我设置 retainDateWindow = TRUE 的原因。除此之外,您不希望在第一次更改滑块后立即重新渲染绘图,这就是我去除子数据抖动的原因。
尽管如此,使用 dygraphs 你仍然有问题,当你将 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()。
我正在构建一个闪亮的应用程序,我想在其中绘制一个数据集,其中一个变量是另一个变量的累积和。每次 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)
这应该可以完成工作,我认为为您的仪表板提供单独的输出更清晰
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)
更新后的代码存在问题,您没有保留日期信息。此外,一旦您开始根据绘图本身的变化(递归)渲染绘图,它就会变得有点棘手。您必须确保重新渲染绘图不会再次触发渲染,否则您将陷入循环。这就是我设置 retainDateWindow = TRUE 的原因。除此之外,您不希望在第一次更改滑块后立即重新渲染绘图,这就是我去除子数据抖动的原因。
尽管如此,使用 dygraphs 你仍然有问题,当你将 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()。