r - 如何将 R 中的自定义悬停文本添加到两个相互引用的系列中

Question

我目前有 plotly 代码(见下面的代码)，它产生如下所示的输出:



而我想要生产的将更像这样:



即我想要自定义文本 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(
  )

我希望能够在 plot_ly 中设置 hoverinfo 参数或 add_lines到“文本”，然后添加一个 text参数来调整上面的代码以生成上面显示的模型图像。

Answer 1

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

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

这给出了以下输出