使用 ggplotly rangeslider 进行交互式相对性能（股票收益）

Posted 2023-02-18

【中文标题】使用 ggplotly rangeslider 进行交互式相对性能（股票收益）

【英文标题】：Using ggplotly rangeslider for interactive relative performance (stock returns)

【发布时间】：2019-10-26 08:37:37

【问题描述】：

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

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

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

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

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

我尝试了几个options for rangeslider。我也尝试使用 ggplot stat_function 但无法达到预期的结果。我还找到了dygraphs，其中有dyRangeSelector。但在这里我也面临同样的问题。

这是我的代码：

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 = "%"))

【参考方案1】：

我找到了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 对象。我不确定这是否是一个错误，因此打开了issue on Github。

【参考方案2】：

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

选项 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 使用 event handlers。我尽量避免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)

【讨论】：

感谢您的回复。选项 1 有效，但选项 2 无效。可能缺少 pltly 定义的某些部分，因为还有一个似乎不应该存在的括号“)”？

感谢您指出pltly 绘图分配中的错误(。它是我原始版本的残余，其中变基是由自定义按钮触发的。没有括号，代码对我来说运行良好（RStudio Viewer）。我上传了完成的HTML Version

在添加实际范围滑块（在 pltly 定义末尾%>% rangeslider()）后，它运行顺利，非常好

我很高兴它对你有用。你介意接受这个解决方案吗？顺便说一句，与dygraphs 解决方案相比，plotly 范围滑块中的数据也被重新设置。我不知道如何防止这种情况。