dygraphs中dyEvents的日期向量输入：R有光泽

Question

I have vector of dates which can be chosen from a drop-down box where multiple dates can be chosen . By selecting those dates event lines will appear at the dates which has been chosen. However I see that the dyEvent is not taking a vector of dates.When date in dyEvent is replaced by a vector event lines do not appear. I have provided the code below. Any help would be greatly appreciated.

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

I don't have any prior experience with the package dygraphs so I can't guarantee this is the simplest approach, but I was able to get the application to function correctly with the code below.

---

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)
    }

  })

})

---

The major changes are the functions between the two commented lines ( ## ). I made a reactive function getDates() that just returns the current selection of dates - I'm not even sure if this is necessary but this is generally what I do with user input. More importantly, I created a (non-reactive) function addEvent that was purposely defined in such a way that is convenient to use with the higher-order function Reduce - ie the x argument represents the previous state (the dygraph object being accumulated), and the y argument is the modification we make to the previous state (the line we are adding).

basePlot() is mostly just a helper function to avoid errors that would most likely be produced when the application first starts (and no date input is selected). If no dates are chosen, it outputs the base dygraph , and if one or more are chosen, it outputs the base graph plus only the first date line.

To return a final plot object (in output$plot ), we create the base plot ( res ), and check for the existence of multiple date inputs. If two or more lines are requested by the user, we use Reduce and the UDF addEvent to accumulate modifications (date lines), using res as the initial value, and the 2nd through last date inputs as the modifying values.

---

Here are a few screen shots of the running applications:

Startup:

---

First input:

---

Multiple inputs:

Answer 2

I think it's a better solution, at least, shorter:

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

https://stackoverflow.com/a/32837723/6253668

dynamically add events to dygraph r