dygraphs中dyEvents的日期向量输入:R shiny
date vector input for dyEvents in dygraphs: R shiny
我有日期向量,可以从下拉框中选择可以选择多个日期。通过选择这些日期,事件行将出现在已选择的日期。但是我看到 dyEvent 没有采用 dates.When 的向量,在 dyEvent 中日期被替换为向量事件行没有出现。我提供了下面的代码。任何帮助将不胜感激。
ui.R
library(shiny)
library(dygraphs)
shinyUI(fluidPage(
titlePanel("Tool"),
sidebarLayout(
sidebarPanel(
uiOutput("choosedates")
),
mainPanel(
dygraphOutput("plot")
)
)
))
server.R
library(shiny)
library(dygraphs)
shinyServer(function(input, output) {
Data<-data.frame(Time=seq(as.Date("7/29/2012","%m/%d/%Y"),as.Date("8/7/2012","%m/%d/%Y"),by="1 day"),Volume=c(100,150,120,300,250,50,100,120,80,100))
output$choosedates<-renderUI({
selectInput("dates","Choose dates to be marked by event line",as.character(Data$Time),multiple=TRUE)
})
library(xts)
Dataxts<-reactive({
xts(Data$Volume,order.by=as.Date(Data$Time,"%m/%d/%Y"))
})
output$plot<-renderDygraph({
dygraph(Dataxts(), main = "Visualization")%>%
dyEvent(date =as.character(input$dates), "Dummy", labelLoc = "bottom",color = "red", strokePattern = "dashed")%>%
dyAxis("y", label = "Units sold in millions")%>%
dyOptions(axisLabelColor = "Black",digitsAfterDecimal = 2,drawGrid = FALSE)
})
})
我之前没有任何使用包 dygraphs
的经验,所以我不能保证这是最简单的方法,但我能够使用下面的代码使应用程序正常运行。
ui.R
library(shiny)
library(dygraphs)
##
shinyUI(fluidPage(
titlePanel("Tool"),
sidebarLayout(
sidebarPanel(
uiOutput("choosedates")
),
mainPanel(
dygraphOutput("plot")
)
)
))
server.R
library(shiny)
library(dygraphs)
library(xts)
##
shinyServer(function(input, output) {
Data <- data.frame(
Time=seq(as.Date("7/29/2012","%m/%d/%Y"),
as.Date("8/7/2012","%m/%d/%Y"),
by="1 day"),
Volume=c(100,150,120,300,250,
50,100,120,80,100))
output$choosedates <- renderUI({
selectInput(
"dates",
"Choose dates to be marked by event line",
as.character(Data$Time),
multiple=TRUE)
})
Dataxts <- reactive({
xts(
Data$Volume,
order.by=as.Date(Data$Time,"%m/%d/%Y"))
})
##
getDates <- reactive({
as.character(input$dates)
})
addEvent <- function(x,y) {
dyEvent(
dygraph=x,
date=y,
"Dummy",
labelLoc = "bottom",
color = "red",
strokePattern = "dashed")
}
basePlot <- reactive({
if (length(getDates()) < 1) {
dygraph(
Dataxts(),
main="Visualization") %>%
dyAxis(
"y",
label = "Units sold in millions") %>%
dyOptions(
axisLabelColor = "Black",
digitsAfterDecimal = 2,
drawGrid = FALSE)
} else {
dygraph(
Dataxts(),
main="Visualization") %>%
dyAxis(
"y",
label = "Units sold in millions") %>%
dyOptions(
axisLabelColor = "Black",
digitsAfterDecimal = 2,
drawGrid = FALSE) %>%
dyEvent(
dygraph=.,
date=getDates()[1],
"Dummy",
labelLoc = "bottom",
color = "red",
strokePattern = "dashed")
}
})
##
output$plot <- renderDygraph({
res <- basePlot()
more_dates <- getDates()
if (length(more_dates) < 2) {
res
} else {
Reduce(function(i,z){
i %>% addEvent(x=.,y=z)
}, more_dates[-1], init=res)
}
})
})
主要变化是两个注释行之间的函数 (##
)。我做了一个反应函数 getDates()
,它只是 return 当前选择的日期——我什至不确定这是否有必要,但这通常是我对用户输入所做的。更重要的是,我创建了一个 (non-reactive) 函数 addEvent
,它被特意定义为便于与 higher-order 函数 Reduce
一起使用的方式 - 即 x
参数表示先前的状态(正在累积的 dygraph
对象),而 y
参数是我们对先前状态所做的修改(我们正在添加的行)。
basePlot()
主要是一个辅助函数,用于避免在应用程序首次启动(并且未选择日期输入)时最有可能产生的错误。如果没有选择日期,它会输出基础 dygraph
,如果选择了一个或多个,它会输出基础图表加上 仅第一个 日期线。
为了 return 最终的绘图对象(在 output$plot
中),我们创建了基础绘图 (res
),并检查是否存在多个日期输入。如果用户请求两行或更多行,我们使用 Reduce
和 UDF addEvent
来累积修改(日期行),使用 res
作为初始值,从第二到最后日期输入作为修改值。
以下是 运行 应用程序的一些屏幕截图:
启动:
第一次输入:
多个输入:
我认为这是一个更好的解决方案,至少更短:
p <- dygraph(df_sub)
for (i in 1:dim(df_sub)[1]){
p <- p %>% dyEvent(date = df_sub$Date[i], label='xyz', labelLoc='bottom')
}
by: user2996185 in Sep 29 '15 at 7:06
我有日期向量,可以从下拉框中选择可以选择多个日期。通过选择这些日期,事件行将出现在已选择的日期。但是我看到 dyEvent 没有采用 dates.When 的向量,在 dyEvent 中日期被替换为向量事件行没有出现。我提供了下面的代码。任何帮助将不胜感激。
ui.R
library(shiny)
library(dygraphs)
shinyUI(fluidPage(
titlePanel("Tool"),
sidebarLayout(
sidebarPanel(
uiOutput("choosedates")
),
mainPanel(
dygraphOutput("plot")
)
)
))
server.R
library(shiny)
library(dygraphs)
shinyServer(function(input, output) {
Data<-data.frame(Time=seq(as.Date("7/29/2012","%m/%d/%Y"),as.Date("8/7/2012","%m/%d/%Y"),by="1 day"),Volume=c(100,150,120,300,250,50,100,120,80,100))
output$choosedates<-renderUI({
selectInput("dates","Choose dates to be marked by event line",as.character(Data$Time),multiple=TRUE)
})
library(xts)
Dataxts<-reactive({
xts(Data$Volume,order.by=as.Date(Data$Time,"%m/%d/%Y"))
})
output$plot<-renderDygraph({
dygraph(Dataxts(), main = "Visualization")%>%
dyEvent(date =as.character(input$dates), "Dummy", labelLoc = "bottom",color = "red", strokePattern = "dashed")%>%
dyAxis("y", label = "Units sold in millions")%>%
dyOptions(axisLabelColor = "Black",digitsAfterDecimal = 2,drawGrid = FALSE)
})
})
我之前没有任何使用包 dygraphs
的经验,所以我不能保证这是最简单的方法,但我能够使用下面的代码使应用程序正常运行。
ui.R
library(shiny)
library(dygraphs)
##
shinyUI(fluidPage(
titlePanel("Tool"),
sidebarLayout(
sidebarPanel(
uiOutput("choosedates")
),
mainPanel(
dygraphOutput("plot")
)
)
))
server.R
library(shiny)
library(dygraphs)
library(xts)
##
shinyServer(function(input, output) {
Data <- data.frame(
Time=seq(as.Date("7/29/2012","%m/%d/%Y"),
as.Date("8/7/2012","%m/%d/%Y"),
by="1 day"),
Volume=c(100,150,120,300,250,
50,100,120,80,100))
output$choosedates <- renderUI({
selectInput(
"dates",
"Choose dates to be marked by event line",
as.character(Data$Time),
multiple=TRUE)
})
Dataxts <- reactive({
xts(
Data$Volume,
order.by=as.Date(Data$Time,"%m/%d/%Y"))
})
##
getDates <- reactive({
as.character(input$dates)
})
addEvent <- function(x,y) {
dyEvent(
dygraph=x,
date=y,
"Dummy",
labelLoc = "bottom",
color = "red",
strokePattern = "dashed")
}
basePlot <- reactive({
if (length(getDates()) < 1) {
dygraph(
Dataxts(),
main="Visualization") %>%
dyAxis(
"y",
label = "Units sold in millions") %>%
dyOptions(
axisLabelColor = "Black",
digitsAfterDecimal = 2,
drawGrid = FALSE)
} else {
dygraph(
Dataxts(),
main="Visualization") %>%
dyAxis(
"y",
label = "Units sold in millions") %>%
dyOptions(
axisLabelColor = "Black",
digitsAfterDecimal = 2,
drawGrid = FALSE) %>%
dyEvent(
dygraph=.,
date=getDates()[1],
"Dummy",
labelLoc = "bottom",
color = "red",
strokePattern = "dashed")
}
})
##
output$plot <- renderDygraph({
res <- basePlot()
more_dates <- getDates()
if (length(more_dates) < 2) {
res
} else {
Reduce(function(i,z){
i %>% addEvent(x=.,y=z)
}, more_dates[-1], init=res)
}
})
})
主要变化是两个注释行之间的函数 (##
)。我做了一个反应函数 getDates()
,它只是 return 当前选择的日期——我什至不确定这是否有必要,但这通常是我对用户输入所做的。更重要的是,我创建了一个 (non-reactive) 函数 addEvent
,它被特意定义为便于与 higher-order 函数 Reduce
一起使用的方式 - 即 x
参数表示先前的状态(正在累积的 dygraph
对象),而 y
参数是我们对先前状态所做的修改(我们正在添加的行)。
basePlot()
主要是一个辅助函数,用于避免在应用程序首次启动(并且未选择日期输入)时最有可能产生的错误。如果没有选择日期,它会输出基础 dygraph
,如果选择了一个或多个,它会输出基础图表加上 仅第一个 日期线。
为了 return 最终的绘图对象(在 output$plot
中),我们创建了基础绘图 (res
),并检查是否存在多个日期输入。如果用户请求两行或更多行,我们使用 Reduce
和 UDF addEvent
来累积修改(日期行),使用 res
作为初始值,从第二到最后日期输入作为修改值。
以下是 运行 应用程序的一些屏幕截图:
启动:
第一次输入:
多个输入:
我认为这是一个更好的解决方案,至少更短:
p <- dygraph(df_sub)
for (i in 1:dim(df_sub)[1]){
p <- p %>% dyEvent(date = df_sub$Date[i], label='xyz', labelLoc='bottom')
}
by: user2996185 in Sep 29 '15 at 7:06