r语言 - 使用 ggplotly 范围滑块进行交互式相对性能(股票回报)

Question

我正在尝试从R制作交互式股票表现图。它是比较几只股票的相对表现。每只股票的表现线应从0%开始。

对于静态图，我将使用 dplyr group_by 和 mutate 来计算性能(请参阅我的代码(。

使用 ggplot2 和 plotly/ggplotly，rangeslider() 允许交互式选择 x 轴范围。现在我希望性能从所选的任何开始范围从 0 开始。

如何将 dplyr 计算移动到绘图中，或者让反馈循环在范围更改时重新计算？

理想情况下，它应该可以在静态RMarkdown HTML中使用。或者，我也会切换到闪亮。

我尝试了范围滑块的几个选项。我也尝试了使用 ggplot stat_function但无法达到预期的结果。我还发现了dyRangeSelector的dygraphs.但在这里我也面临着同样的问题。

这是我的代码：

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

如果你不想

使用shiny，你可以使用dygraphs中的dyRebase选项，或者你必须在plotly中插入自定义javascript代码。在这两个例子中，我都变基为一，而不是零。

选项 1：带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()

请注意，'dyRebase(value = 0( 不起作用。

选项 2：使用事件处理程序plotly。我尽量避免ggplotly，因此我plot_ly解决方案。这里的时间选择只是通过缩放，但我认为也可以通过范围选择器来完成。onRenderRebaseTxt中的javascript代码将每个跟踪重定为第一个可见数据点(处理可能的缺失值(。它只在relayout事件中调用，因此第一次变基必须在情节之前完成。

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

我找到了一个带有plotly_relayout的解决方案，它可以读取可见的x轴范围。这用于重新计算性能。它作为一个闪亮的应用程序工作。这是我的代码：

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)

定义范围滑块的开始/结束仅适用于plot_ly，不适用于由ggplotly转换的ggplot对象。我不确定这是否是一个错误，因此在 Github 上打开了一个问题。