r - dygraphs : R shiny 中 dyEvents 的日期向量输入

Question

我有日期矢量，可以从下拉框中选择可以选择多个日期。通过选择这些日期，事件行将出现在已选择的日期。但是我看到 dyEvent 没有采用日期向量。当 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)
  })
  })

Answer 1

我之前没有任何使用 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)
    }

  })

})

---

主要变化是两个注释行 (##) 之间的函数。我创建了一个 react 函数 getDates()，它只返回当前选择的日期——我什至不确定这是否有必要，但这通常是我对用户输入所做的。更重要的是，我创建了一个(非 react 性)函数 addEvent，它是有意定义的，以便于与高阶函数 Reduce 一起使用 - 即x 参数表示之前的状态(正在累积的 dygraph 对象)，y 参数是我们对之前状态所做的修改(我们正在添加的行)。

basePlot() 主要只是一个辅助函数，用于避免在应用程序首次启动(并且未选择日期输入)时很可能产生的错误。如果没有选择日期，它会输出基础 dygraph，如果选择了一个或多个，它会输出基础图加上仅第一个日期线。

为了返回最终绘图对象(在 output$plot 中)，我们创建了基本绘图 (res)，并检查是否存在多个日期输入。如果用户请求两行或更多行，我们使用 Reduce 和 UDF addEvent 来累积修改(日期行)，使用 res 作为初始值，以及第二个到最后一个日期输入作为修改值。

---

以下是正在运行的应用程序的一些屏幕截图:

启动:

---

第一次输入:

---

多个输入: