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

时间:2019-07-11 12:07:02

标签: r plotly

我目前有一些绘图代码(请参见下面的代码),它们产生的输出看起来像这样:

Current

我想生产的东西会更像这样:

enter image description here

即我想要自定义文本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_lyadd_lines中的hoverinfo参数设置为“ text”,然后添加一个text参数以适应上面的代码以产生模拟的上图所示。

1 个答案:

答案 0 :(得分:3)

一个稍微有点怪异的解决方案,但是可以与您的示例一起使用。也许值得一试,看看字符变量是如何形成的。

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

这给出了以下输出