如何在R中以自定义方式将自定义悬浮文本添加到两个互相引用的系列中

Question

我目前有一些可绘制的代码（请参见下面的代码），它们产生的输出看起来像这样：

而我想要生产的东西将更像这样：

即，我希望自定义文本hoverinfo可以针对两个系列同时显示另一个系列的相应信息，并报告哪个更高或更低。

生成第一张图片的代码：

require(tidyverse)
require(plotly)

data("beavers")

beaver_tidy <- beaver1 %>% 
  mutate(label = "a") %>% 
  bind_rows(
    beaver2 %>% 
      mutate(label = "b")
  ) %>% 
  mutate(daytime  = day * max(time) + time) %>% 
  as_tibble()


beaver_tidy %>% 
  group_by(label) %>% 
  plot_ly(
    x = ~ time, y = ~temp, color = ~label
  ) %>% 
  add_lines(
  )

我希望能够将hoverinfo参数设置为“文本” plot_ly或add_lines将其设置为“文本”，然后添加一个text参数以适应上面的代码以产生上面显示的模拟图像。

Answer 1

一个有点老套的解决方案，但它适用于您的示例。可能值得分解管道来看看字符变量是如何形成的。

library(tidyverse)
library(plotly)
library(glue)

beaver_tidy %>%
  group_by(time) %>%
  #utilise glue to add temperature value to a string
  mutate(main_label = glue("{label} value is {temp}"),
  #now add another variable with the opposite value (with conditions)
  opp_label = case_when(
    #n() counts the number of rows in the time group
    label == "a" & n() == 2 ~ lead(main_label),
    label == "b" & n() == 2 ~ lag(main_label),
       n() == 1 ~ ""),
     #add a string with difference calculated (gives some NA values)
     diff = glue("difference is {round(temp - lead(temp),2)}"),
     #combine strings into one variable with conditions
     comb = case_when(
       diff == "difference is NA" & n() == 1 ~ str_c(main_label, 
                                                     "<br>",
                                                     "No corresponding value", 
                                                      sep = " "),
       diff == "difference is NA" & n() == 2 ~ str_c(main_label, 
                                                     "<br>",
                                                     opp_label, 
                                                     "<br>",
                                                     lag(diff),
                                                     sep = " "),
       TRUE ~ str_c(main_label, 
                    "<br>",
                    opp_label,
                    "<br>",
                     diff, 
                     sep = " ") )) %>%
#and pipe into the original plot
group_by(label) %>% 
plot_ly(x = ~ time, 
        y = ~temp, 
        color = ~label) %>% 
add_lines() %>% 
#add in the hover text
add_trace(x = ~ time, 
          y = ~temp, 
          text = ~comb, 
          hoverinfo = "text")

这给出了以下输出