Using ggplotly rangeslider for interactive relative performance (stock returns)

Question

I am trying to make an interactive stock performance plot from R. It is to compare the relative performance of several stocks. Each stock's performance line should start at 0%.

For static plots I would use dplyr group_by and mutate to calculate performance (see my code).

With ggplot2 and plotly/ggplotly, rangeslider() allows to interactively select the x-axis range. Now I'd like performance to be starting at 0 from any start range selected.

How can I either move the dplyr calculation into the plotting or have a feedback loop to recalculate as the range is changed?

Ideally it should be usable in static RMarkdown HTML. Alternatively I'd also switch to Shiny.

I tried several options for rangeslider. Also I tried with ggplot stat_function but could not achieve the desired result. Also I found dygraphs which has dyRangeSelector. But also here I face the same problem.

This is my code:

library(plotly)
library(tidyquant)

stocks <- tq_get(c("AAPL", "MSFT"), from = "2019-01-01")

range_from <- as.Date("2019-02-01")

stocks_range <- stocks %>% 
  filter(date >= range_from) %>% 
  group_by(symbol) %>% 
  mutate(performance = adjusted/first(adjusted)-1)

p <- stocks_range %>% 
  ggplot(aes(x = date, y = performance, color = symbol)) +
  geom_line()

ggplotly(p, dynamicTicks = T) %>%
  rangeslider(borderwidth = 1) %>%
  layout(hovermode = "x", yaxis = list(tickformat = "%"))

Answer 1

If you do not want to use shiny, you can either use the dyRebase option in dygraphs, or you have to insert custom javascript code in plotly. In both examples, I rebase to one, not zero.

Option 1: with dygraphs

library(dygraphs)
library(tidyquant)
library(timetk)
library(tidyr)

stocks <- tq_get(c("AAPL", "MSFT"), from = "2019-01-01")

stocks %>% 
  dplyr::select(symbol, date, adjusted) %>% 
  tidyr::spread(key = symbol, value = adjusted) %>% 
  timetk::tk_xts() %>% 
  dygraph() %>%
  dyRebase(value = 1) %>% 
  dyRangeSelector()

Note that `dyRebase(value = 0) does not work.

Option 2: with plotly using event handlers. I try to avoid ggplotly, hence my plot_ly solution. Here the time selection is just by zooming, but I think it can be done by a range selector as well. The javascript code in onRenderRebaseTxt rebases every trace to the first visible data point (taking care of possible missing values). It is only called with the relayout event, hence the first rebasing must be done before the plot.

library(tidyquant)
library(plotly)
library(htmlwidgets)
library(dplyr)

stocks <- tq_get(c("AAPL", "MSFT"), from = "2019-01-01")

pltly <- 
  stocks %>% 
  dplyr::group_by(symbol) %>% 
  dplyr::mutate(adjusted = adjusted / adjusted[1L]) %>% 
  plotly::plot_ly(x = ~date, y = ~adjusted, color = ~symbol,
                  type = "scatter", mode = "lines") %>% 
  plotly::layout(dragmode = "zoom", 
                 datarevision = 0)

onRenderRebaseTxt <- "
  function(el, x) {
el.on('plotly_relayout', function(rlyt) {
        var nrTrcs = el.data.length;
        // array of x index to rebase to; defaults to zero when all x are shown, needs to be one per trace
        baseX = Array.from({length: nrTrcs}, (v, i) => 0);
        // if x zoomed, increase baseX until first x point larger than x-range start
        if (el.layout.xaxis.autorange == false) {
            for (var trc = 0; trc < nrTrcs; trc++) {
                while (el.data[[trc]].x[baseX[trc]] < el.layout.xaxis.range[0]) {baseX[trc]++;}
            }   
        }
        // rebase each trace
        for (var trc = 0; trc < nrTrcs; trc++) {
            el.data[trc].y = el.data[[trc]].y.map(x => x / el.data[[trc]].y[baseX[trc]]);
        }
        el.layout.yaxis.autorange = true; // to show all traces if y was zoomed as well
        el.layout.datarevision++; // needs to change for react method to show data changes
        Plotly.react(el, el.data, el.layout);

});
  }
"
htmlwidgets::onRender(pltly, onRenderRebaseTxt)

Answer 2

I found a solution with plotly_relayout which reads out the visible x-axis range. This is used to recompute the performance. It works as a Shiny app. Here's my code:

library(shiny)
library(plotly)
library(tidyquant)
library(lubridate)

stocks <- tq_get(c("AAPL", "MSFT"), from = "2019-01-01")

ui <- fluidPage(
    titlePanel("Rangesliding performance"),
        mainPanel(
           plotlyOutput("plot")
        )
)

server <- function(input, output) {

  d <- reactive({ e <- event_data("plotly_relayout")
                  if (is.null(e)) {
                    e$xaxis.range <- c(min(stocks$date), max(stocks$date))
                  }
                  e })

  stocks_range_dyn <- reactive({
    s <- stocks %>%
      group_by(symbol) %>%
      mutate(performance = adjusted/first(adjusted)-1)

    if (!is.null(d())) {
      s <- s %>%
        mutate(performance = adjusted/nth(adjusted, which.min(abs(date - date(d()$xaxis.range[[1]]))))-1)
    }

    s
  })

    output$plot <- renderPlotly({

      plot_ly(stocks_range_dyn(), x = ~date, y = ~performance, color = ~symbol) %>% 
        add_lines() %>%
        rangeslider(start =  d()$xaxis.range[[1]], end =  d()$xaxis.range[[2]], borderwidth = 1)

      })
}

shinyApp(ui = ui, server = server)

Definign the start/end of the rangeslider only works with plot_ly, not with a ggplot object converted by ggplotly. I am unsure if this is a bug, therefore opened an issue on Github.