英文:
Tooltips in plotly generated from ggplot geom_tile
问题
我试图制作一个带有两个垂直轴和鼠标悬停工具提示的交互式Plotly图形。图中应该有y1数据点和y2数据条形。当我在两边的数据都使用点时，一切都按需要工作，但当我在y2上使用条形时，无法显示正确的信息。
使用两边的点工作正常：
![点][1]
使用geom_tile生成的右侧条形时，每个条的工具提示都显示相同ID的所有条的信息：
![条形][2]
可能会有一些相关的补充信息：
- 我使用
geom_tile生成条形，因为我需要能够反转轴，而使用其他几何图形时遇到了困难。我基于[这个SO回答][3]采用了geom_tile。 - 需要从ggplot对象生成Plotly图，而不是直接生成Plotly图。这是一个大型Shiny应用的一部分，我需要将ggplot对象存储在另一个位置，并进一步进行其他操作。
MRE
**注意：**我不确定我的示例是否足够简化，因为我不太清楚哪个步骤会导致工具提示出错。因此，我更喜欢在这里包括我的应用程序案例的所有元素：两个垂直轴、反转和包括有问题的条形的两种不同的几何图形。
数据
# 用于垂直轴y1（左侧）df1 <- data.frame(ID = c("A", "A", "A", "A", "B", "B", "B", "B"),Date = structure(c(19078, 19085, 19092, 19099, 19078, 19085, 19092, 19099), class = "Date"),Val = c(236, 221, 187, 136, 77, 100, 128, 180))# 用于垂直轴y2（右侧）df2 <- data.frame(ID = c("J", "J", "J", "J", "K", "K", "K", "K"),Date = structure(c(19078, 19085, 19092, 19099, 19078, 19085, 19092, 19099), class = "Date"),Val = c(478, 500, 549, 479, 73, 5, 15, 74))
工作正常的情况下，两侧都是点
library(ggplot2)library(dplyr)library(plotly)# 准备y2缩放数据ylim1 <- rev(range(df1$Val))ylim2 <- range(df2$Val)scale_y2.1 <- function(y, ylim1, ylim2) {ylim1[1] + (ylim1[2] - ylim1[1]) *(y - ylim2[1])/(ylim2[2] - ylim2[1])}dfAll <- full_join(df1, df2, by = c("ID", "Date"), suffix = c("1", "2"))y2.scl <- scale_y2.1(dfAll$Val2, ylim1, ylim2)dfAll <- dfAll %>% mutate(Val2_scl = y2.scl)# 准备y2刻度和缩放的刻度线labs2 <- pretty(ylim2)brks2 <- scale_y2.1(labs2, ylim1, ylim2)# 生成ggplotggp1 <- ggplot(dfAll) +geom_point(aes(x = Date, y = Val1, color = ID, group = ID), na.rm = TRUE) +geom_point(aes(x = Date, y = Val2_scl, group = ID, color = ID), na.rm = TRUE, shape = 4, stroke = 0.6) +scale_y_continuous(trans = "reverse",sec.axis = dup_axis(breaks = rev(brks2), labels = rev(labs2), name = "Val2")) +coord_cartesian(ylim = rev(ylim1))# 生成Plotly图yaxis2 <- list(overlaying = "y", range = rev(ylim2), ticks = 'outside', side = "right",title = "Val2", zeroline = FALSE, showgrid = FALSE, automargin = TRUE,tickfont = list(size = 11.8), titlefont = list(size = 14.6))ply1 <- ggplotly(ggp1) %>%add_lines(x = ~Date, y = ~Val2_scl, yaxis = "y2", data = dfAll, inherit = FALSE) %>%style(showlegend = FALSE) %>%layout(yaxis2 = yaxis2)# 插入工具提示tlTips <- paste0("Value: ", c(df1$Val, df2$Val), '\n',"Date: ", dfAll$Date, '\n',"ID: ", dfAll$ID)for (i in seq_along(ply1$x$data)) {aName <- ply1$x$data[[i]]$nameif (!is.null(aName)) {aTags <- grep(aName, tlTips, value = TRUE, fixed = TRUE)ply1$x$data[[i]]$text <- aTags}}# 显示图形ply1
条形在右侧时出错
# 生成ggplotggp2 <- ggplot(dfAll) +geom_point(aes(x = Date, y = Val1, color = ID, group = ID), na.rm = TRUE) +geom_tile(aes(x = Date, y = (ylim1[1] + Val2_scl)/2, height = ylim1[1] - Val2_scl, fill = ID, group = ID),na.rm = TRUE, stat = "identity", position = position_dodge(preserve = "single")) +scale_y_continuous(trans = "reverse",sec.axis = dup_axis(breaks = rev(brks2), labels = rev(labs2), name = "Val2")) +coord_cartesian(ylim = rev(ylim1))# 生成Plotly图ply2 <- ggplotly(ggp2) %>%add_lines(x = ~Date, y = ~Val2_scl, yaxis = "y2", data = dfAll, inherit = FALSE) %>%style(showlegend =<details><summary>英文:</summary>I'm trying to produce an interactive plotly graphic with two vertical axes and on-hover tooltips. The plot should have y1 data as points and y2 data as bars. **Everything works just as needed when I use points for data in both sides, but when I use bars for y2 I cannot get the tooltips to display the correct information.**With points at both sides tooltips display fine:[![points][1]][1]With `geom_tile` bars at the right side, every bar's tooltip displays the information of all the bars of the same ID:[![bars][2]][2]Some complementary information that could be relevant:- I'm using `geom_tile` to produce the bars because I need to be able to reverse the axes and I was having difficulties doing that with other geoms. I adopted `geom_tile` based on [this SO answer][3].- It is necessary to produce the plotly graphic from a ggplot one, not directly the plotly one. This is part of a large Shiny app that I got to work on, where the ggplot object is stored apart and further manipulated for other purposes.---------------------### MRE**Note:** I'm not sure if my example is minimal because I don't know well what part of the process is messing up the tooltips. Thus, I prefer to include all elements of my application case here: two vertical axes, reversing and two different geoms including the problematic bars.** Data# for vertical axis y1 (left)df1 <- data.frame(ID = c("A", "A", "A", "A", "B", "B", "B", "B"),Date = structure(c(19078, 19085, 19092, 19099, 19078, 19085, 19092, 19099), class = "Date"),Val = c(236, 221, 187, 136, 77, 100, 128, 180))# for vertical axis y2 (right)df2 <- data.frame(ID = c("J", "J", "J", "J", "K", "K", "K", "K"),Date = structure(c(19078, 19085, 19092, 19099, 19078, 19085, 19092, 19099), class = "Date"),Val = c(478, 500, 549, 479, 73, 5, 15, 74))** **Working case** with points at both sideslibrary(ggplot2)library(dplyr)library(plotly)# prepare y2 scaled dataylim1 <- rev(range(df1$Val))ylim2 <- range(df2$Val)scale_y2.1 <- function(y, ylim1, ylim2) {ylim1[1] + (ylim1[2] - ylim1[1]) *(y - ylim2[1])/(ylim2[2] - ylim2[1])}dfAll <- full_join(df1, df2, by = c("ID", "Date"), suffix = c("1", "2"))y2.scl <- scale_y2.1(dfAll$Val2, ylim1, ylim2)dfAll <- dfAll %>% mutate(Val2_scl = y2.scl)# prepare y2 ticks and scaled breakslabs2 <- pretty(ylim2)brks2 <- scale_y2.1(labs2, ylim1, ylim2)# generate ggplotggp1 <- ggplot(dfAll) +geom_point(aes(x = Date, y = Val1, color = ID, group = ID), na.rm = TRUE) +geom_point(aes(x = Date, y = Val2_scl, group = ID, color = ID), na.rm = TRUE, shape = 4, stroke = 0.6) +scale_y_continuous(trans = "reverse",sec.axis = dup_axis(breaks = rev(brks2), labels = rev(labs2), name = "Val2")) +coord_cartesian(ylim = rev(ylim1))# generate plotlyyaxis2 <- list(overlaying = "y", range = rev(ylim2), ticks = 'outside', side = "right",title = "Val2", zeroline = FALSE, showgrid = FALSE, automargin = TRUE,tickfont = list(size = 11.8), titlefont = list(size = 14.6))ply1 <- ggplotly(ggp1) %>%add_lines(x = ~Date, y = ~Val2_scl, yaxis = "y2", data = dfAll, inherit = FALSE) %>%style(showlegend = FALSE) %>%layout(yaxis2 = yaxis2)# insert tooltipstlTips <- paste0("Value: ", c(df1$Val, df2$Val), '\n',"Date: ", dfAll$Date, '\n',"ID: ", dfAll$ID)for (i in seq_along(ply1$x$data)) {aName <- ply1$x$data[[i]]$nameif (!is.null(aName)) {aTags <- grep(aName, tlTips, value = TRUE, fixed = TRUE)ply1$x$data[[i]]$text <- aTags}}# displayply1** **Broken case** with bars at right side# generate ggplotggp2 <- ggplot(dfAll) +geom_point(aes(x = Date, y = Val1, color = ID, group = ID), na.rm = TRUE) +geom_tile(aes(x = Date, y = (ylim1[1] + Val2_scl)/2, height = ylim1[1] - Val2_scl, fill = ID, group = ID),na.rm = TRUE, stat = "identity", position = position_dodge(preserve = "single")) +scale_y_continuous(trans = "reverse",sec.axis = dup_axis(breaks = rev(brks2), labels = rev(labs2), name = "Val2")) +coord_cartesian(ylim = rev(ylim1))# generate plotlyply2 <- ggplotly(ggp2) %>%add_lines(x = ~Date, y = ~Val2_scl, yaxis = "y2", data = dfAll, inherit = FALSE) %>%style(showlegend = FALSE) %>%layout(yaxis2 = yaxis2)# insert tooltipsfor (i in seq_along(ply2$x$data)) {aName <- ply2$x$data[[i]]$nameif (!is.null(aName)) {t1 <- grepl("(", aName, fixed = TRUE)t2 <- grepl(",", aName, fixed = TRUE)t3 <- grepl(")", aName, fixed = TRUE)if (all(t1, t2, t3)) {aName <- strsplit(sub("(", "", aName, fixed = TRUE), ",", fixed = TRUE)[[1]][1]}aTags <- grep(aName, tlTips, value = TRUE, fixed = TRUE)ply2$x$data[[i]]$text <- aTags}}# displayply2[1]: https://i.stack.imgur.com/AkTqR.png[2]: https://i.stack.imgur.com/6Q29F.png[3]: https://stackoverflow.com/a/76310566/12372421</details># 答案1**得分**: 2# Option 1:这个修改修改了您用于修改工具提示的`for`语句。我使用了工具提示的*绘图*数据。我不确定这是否是您想要的瓷砖的值或ID，但至少您会看到我如何更改它。`lapply`从`if(`...跟踪是`markers`的部分开始。代码的这一部分与您的`for`语句中的内容几乎完全相同。请注意评论中唯一更改的地方（`<<`而不是`<`）。`else(`...是如果跟踪不是标记（线/瓷砖）。在`else`中，我提取文本，它看起来像这样：`"Date: 2022-03-27<br />(ylim1[1] + Val2_scl)/2: 166.8759<br />ylim1[1] - Val2_scl: NA<br />ID: J<br />ID: J"`。首先我按`<br />`（换行符）拆分。然后第二个断点（`"(ylim1[1] + Val2_scl)/2: 166.8759"`）按`:`拆分。接下来，我按标记中使用的顺序重新构建提示（值，日期，然后ID）。#### 代码这从您的问题中的对象`ggp2`开始。```R#----------- 这部分与您的代码相同 ------------# 生成plotly图ply2 <- ggplotly(ggp2) %>%add_lines(x = ~Date, y = ~Val2_scl, yaxis = "y2", data = dfAll, inherit = FALSE) %>%style(showlegend = FALSE) %>%layout(yaxis2 = yaxis2)#----------- 我的修改开始的地方 -------------# 这在很大程度上与问题中的for()语句的内容基本相同invisible(lapply(1:length(ply2$x$data), function(i) {if(ply2$x$data[[i]]$mode == "markers") { # 所有内容都来自于您的for()语句aName <- ply2$x$data[[i]]$nameif (!is.null(aName)) {t1 <- grepl("(", aName, fixed = TRUE)t2 <- grepl(",", aName, fixed = TRUE)t3 <- grepl(")", aName, fixed = TRUE)if (all(t1, t2, t3)) {aName <- strsplit(sub("(", "", aName, fixed = TRUE), ",", fixed = TRUE)[[1]][1]}aTags <- grep(aName, tlTips, value = TRUE, fixed = TRUE)ply2$x$data[[i]]$text <<- aTags # <--------- 这里有改动!}} else { # 否则模式不是markers（瓷砖/线）if(!is.null(ply2$x$data[[i]]$text)) { # 如果存在文本# 按换行符拆分当前多行字符串的工具提示aName <- strsplit(ply2$x$data[[i]]$text, "<br />", fixed = T)l2 <- strsplit(aName[[1]][2], ":") # 拆分 'Value' 行# 根据标记提示中的顺序重新构建瓷砖的工具提示# 和绘图数据aTag <- paste0("Value:", l2[[1]][2], "<br />", aName[[1]][1],"<br />", aName[[1]][length(aName[[1]])])ply2$x$data[[i]]$text <<- aTag # 注意 <<-}}}))ply2
[![enter image description here][1]][1]
Option 2:
感谢Kat的建议，我能够实现一种适用于geom_point() - geom_tile()和geom_line() - geom_tile()组合的方法，它在每个条形上安装了正确的Value、Date和ID。Kat的意见对于开发我的版本非常重要，所以我决定将这段代码作为答案的附加部分添加，而不是发布新答案。
- 为了简单起见，我回到了使用
for循环。无论如何，这只涉及到几次迭代。 - 这次我使用了
geom_line()与geom_tile()的组合来说明一种情况，其中ply2$x$data[[i]]$mode无法区分线和瓷砖跟踪。然而，该代码足够通用，也适用于geom_point()与geom_tile()的组合使用。 - 我准备了两个不同于条形的凹面和一个用于条形的凹面的工具提示向量。
代码
从ggplot对象定义开始。
# 生成ggplot图ggp2 <- ggplot(dfAll) +geom_line(aes(x = Date, y = Val1, color = ID, group = ID), na.rm = TRUE) +geom_tile(aes(x = Date, y = (ylim1[1] + Val2_scl)/2, height = ylim1[1] - Val2_scl, fill = ID, group = ID),na.rm = TRUE, stat = "identity", position = position_dodge(preserve = "single")) +scale_y_continuous(trans = "reverse",sec.axis = dup_axis(breaks = rev(brks2), labels = rev(labs2), name = "Val2")) +coord_cartesian(ylim = rev(ylim1))# 生成plotly图ply2 <- ggplotly(ggp2) %>%add_lines(x = ~Date, y = ~Val2_scl, yaxis = "y2", data = dfAll, inherit = FALSE) %>%style(showlegend = FALSE) %>%layout(yaxis2 = yaxis2)# 准备工具提示# - 用于与凹面和线条相关的其他图元tlTipsOthers <- paste0("Value: ", df1<details><summary>英文:</summary># Option 1:This modification modifies your `for` statement that you used to modify the tooltips. I used the *plotting* data for the tooltips. I'm not sure if that is the value or ID you wanted for the tiles, but you'll at least see how I changed it.The `lapply` starts with `if(`...the trace is `markers`. This part of the code is mostly identical to the content in your `for` statement. Note the comment indicating the only thing I changed (`<<` instead of `<`).The `else(`... is if the trace is *not* markers (lines/tiles).In the `else`, I extract the text, which looks like this: `"Date: 2022-03-27<br />(ylim1[1] + Val2_scl)/2: 166.8759<br />ylim1[1] - Val2_scl: NA<br />ID: J<br />ID: J"`.First I split by `<br />` (linebreaks). Then the second break (`"(ylim1[1] + Val2_scl)/2: 166.8759"`) is split by the `:`. Next, I rebuild the tip in the order used in the markers (value, date, then id).#### The CodeThis starts with the object `ggp2` from your question.
#----------- this is unchanged from your code ------------
generate plotly
ply2 <- ggplotly(ggp2) %>%
add_lines(x = ~Date, y = ~Val2_scl, yaxis = "y2", data = dfAll, inherit = FALSE) %>%
style(showlegend = FALSE) %>%
layout(yaxis2 = yaxis2)
#----------- where my mods start -------------
this is mostly the same content as in you the question's for statement
invisible(lapply(1:length(ply2$x$data), function(i) {
if(ply2$x$data[[i]]$mode == "markers") { # all in if is from your for() statement
aName <- ply2$x$data[[i]]$name
if (!is.null(aName)) {
t1 <- grepl("(", aName, fixed = TRUE)
t2 <- grepl(",", aName, fixed = TRUE)
t3 <- grepl(")", aName, fixed = TRUE)
if (all(t1, t2, t3)) {aName <- strsplit(sub("(", "", aName, fixed = TRUE), ",", fixed = TRUE)[[1]][1]}aTags <- grep(aName, tlTips, value = TRUE, fixed = TRUE)ply2$x$data[[i]]$text <<- aTags # <--------- this is changed!}
} else { # else the mode is NOT markers (tiles/lines)
if(!is.null(ply2$x$data[[i]]$text)) { # if text exists
# split the current multiple stringed tooltip by line break
aName <- strsplit(ply2$x$data[[i]]$text, "<br />", fixed = T)
l2 <- strsplit(aName[[1]][2], ":") # split 'Value' line
# rebuild tooltip for tiles based on the order in markers tips# and plotting dataaTag <- paste0("Value:", l2[[1]][2], "<br />", aName[[1]][1],"<br />", aName[[1]][length(aName[[1]])])ply2$x$data[[i]]$text <<- aTag # note the << for envir assign}
}
}))
ply2
[![enter image description here][1]][1]------------------------------------------# Option 2:*Thanks to Kat's suggestions, I was able to implement an approach which (i) works for combinations of `geom_point()` - `geom_tile()` and `geom_line()` - `geom_tile()`; and (ii) installs the correct Value, Date and ID on each bar. Kat's input was fundamental to have my version developed so I decided it was better to add this code as an addition to this answer rather than posting a new one.*- I got back to a for loop for simplicity. Anyway it only involves a few iterations.- This time I used `geom_line()` in combination with `geom_tile()` to illustrate a case where `ply2$x$data[[i]]$mode` doesn't let one differentiate between lines and tiles traces. However, the code is general enough to work also if `geom_point()` is used in combination with `geom_tile()`.- I prepared two separate tooltip vectors, one for other geoms different to bars and one for bars.#### The CodeStarting from the `ggplot` object definition.# generate ggplotggp2 <- ggplot(dfAll) +geom_line(aes(x = Date, y = Val1, color = ID, group = ID), na.rm = TRUE) +geom_tile(aes(x = Date, y = (ylim1[1] + Val2_scl)/2, height = ylim1[1] - Val2_scl, fill = ID, group = ID),na.rm = TRUE, stat = "identity", position = position_dodge(preserve = "single")) +scale_y_continuous(trans = "reverse",sec.axis = dup_axis(breaks = rev(brks2), labels = rev(labs2), name = "Val2")) +coord_cartesian(ylim = rev(ylim1))# generate plotlyply2 <- ggplotly(ggp2) %>%add_lines(x = ~Date, y = ~Val2_scl, yaxis = "y2", data = dfAll, inherit = FALSE) %>%style(showlegend = FALSE) %>%layout(yaxis2 = yaxis2)# prepare tooltips# - for geom_point and geom_line related tracestlTipsOthers <- paste0("Value: ", df1$Val, '\n',"Date: ", df1$Date, '\n',"ID: ", df1$ID)# - for geom_tiles related tracestlTipsTiles <- paste0("Value: ", df2$Val, '\n',"Date: ", df2$Date, '\n',"ID: ", df2$ID)# insert tooltipstilePivs <- c()for (i in seq_along(ply2$x$data)) { # tooltips for traces other than tiles# i <- 0# i <- i + 1aName <- ply2$x$data[[i]]$nameif (!is.null(aName)) {t1 <- grepl("(", aName, fixed = TRUE)t2 <- grepl(",", aName, fixed = TRUE)t3 <- grepl(")", aName, fixed = TRUE)if (all(t1, t2, t3)) {aName <- strsplit(sub("(", "", aName, fixed = TRUE), ",", fixed = TRUE)[[1]][1]}# determine if this is a geom_tile() trace, else insert others' tooltipsif (any(grepl(aName, tlTipsTiles, fixed = TRUE)) && ply2$x$data[[i]]$hoveron == "fills") {tilePivs <- c(tilePivs, i)} else {aTags <- grep(aName, tlTipsOthers, value = TRUE, fixed = TRUE)ply2$x$data[[i]]$text <- aTags}}}for (i in seq_along(tilePivs)) { # tooltips for tiles tracesply2$x$data[[tilePivs[i]]]$text <- tlTipsTiles[[i]]}# displayply2[![lines tooltip ok][2]][2][![tiles tooltip ok][3]][3][1]: https://i.stack.imgur.com/yD9MY.png[2]: https://i.stack.imgur.com/JvZ5C.png[3]: https://i.stack.imgur.com/8AUwe.png</details>
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论