R: more flexible annotations in dygraphs + shiny

问题

I'm using dygraphs in my Shiny app to visualise quite complex time-series. I want to be able to:

1) plot multiple annotations with two labels@ 'buy' and 'sell'. ideally using icons and/or different colours and 2) control which time-series it's going to be plotted on.

Re point 1, I found this SO answer, which works, but it is rather clunky. Is there a better (more tidy) way of achieving the same effect?

Re point 2, see code below - how could I plot annotations on Y time-series, instead?

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)) %>% 
    mutate(action = c(
      rep(c(rep(NA, 7), 'Buy'), 4),
      rep(c(rep(NA, 7), 'Sell'), 5)
    ),
    label = ifelse(action == 'Buy', 'B',
                   ifelse(action == 'Sell', 'S', NA)))



  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)

  # tick_dataB <- m_df %>% select(date, action) %>%  filter(action == 'Buy')
  # tick_dataS <- m_df %>% select(date, action) %>%  filter(action == 'Sell')
  # buy_dates <- tick_dataB$date
  # sell_dates <- tick_dataS$date
  # buy_texts <- rep('B', length(tick_dataB$action))
  # sell_texts <- rep('S', length(tick_dataS$action))
  # buy_labels <- tick_dataB$action
  # sell_labels <- tick_dataS$action
  # 

  output$plot1 <- renderDygraph({
    input_xts <- xts(select(m_df, -c(date, action)), 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")
    }


    dates <- m_df %>% na.omit() %>% pull(date)
    texts <- m_df %>% na.omit() %>% pull(label)
    labels <- m_df %>% na.omit() %>% pull(action) 


    anno_code <- paste('p %>% ',
                       paste0("dyAnnotation('",
                              dates,
                              "', text = '",
                              texts,
                              "', tooltip = '",
                              labels,
                              "')",
                              collapse = " %>% "))

   eval(parse(text = anno_code))

  })

}

shinyApp(ui, server)

The code comes from my other question that I posted here

来源：https://stackoverflow.com/questions/55852639/r-more-flexible-annotations-in-dygraphs-shiny

标签

Shiny

shinydashboard

dygraphs