ggplotly 工具提示显示数据两次

Question

我使用 ggplot 在一张图表中包含 2 个数据集。我正在使用 ggplotly 创建工具提示，但工具提示中 2 个点的信息显示两次。以下代码有点长，但会重新创建图表：

AreaName <- c("A", "B", "C", "A", "B", "C")
Timeperiod <- c("2018", "2018", "2018", "2019", "2019", "2019")
Value <- c(11.5, 39.3, 9.4, 14.2, 40.7, 19.1)
df <- data.frame(cbind(AreaName, Timeperiod, Value), stringsAsFactors = F)
df$Value <- as.numeric(df$Value)

AreaName <- c("A", "A")
Timeperiod <- c("2019", "2020")
qtr <- c("Q1-Q2", "Q1-Q2")
Value <- c(15.6, 10.2)
df2 <- data.frame(cbind(Timeperiod, qtr, AreaName, Value), stringsAsFactors = F)
df2$Value <- as.numeric(df2$Value)

ggp <- ggplotly(ggplot(data = df, aes(x=Timeperiod, y=Value, group = AreaName, colour = AreaName, text = paste("Area name: ", AreaName, "<br>Time period: ", Timeperiod, "<br>Rate: ", round(Value,1), "per 100,000"))) +
  geom_line() +
  geom_point() +
  geom_point(data = df2, aes(shape = c(paste(AreaName, qtr, Timeperiod)),text = paste("Area name: ", AreaName, "<br>Quarter: ", qtr, "<br>Time period: ", Timeperiod, "<br>Rate: ", round(Value,1), "per 100,000"))) +
  scale_shape_manual(values = c(18, 17)) +
  theme(axis.text.x = element_text(vjust = 0.5), axis.title.x = element_blank()) +
  labs(y = "Crude rate per 100,000 persons all ages", colour = "Area", shape = "") +
  guides(shape = guide_legend(order = 2),colour = guide_legend(order = 1)) +
  expand_limits(y=0), tooltip = "text")

ggpNames <- unique(df$AreaName)
legs <- paste(df2$AreaName, df2$qtr, df2$Timeperiod)
ggpNames <- c(ggpNames,legs)

for (i in 1:length(ggp$x$data)) { # this goes over all places where legend values are stored
    n1 <- ggp$x$data[[i]]$name # and this is how the value is stored in plotly
    n2 <- " "
    for (j in 1:length(ggpNames)) {
        if (grepl(x = n1, pattern = ggpNames[j])) {n2 = ggpNames[j]} # if the plotly legend name contains the original value, replace it with the original value
    }
    ggp$x$data[[i]]$name <- n2 # now is the time for actual replacement
    if (n2 == " ") {ggp$x$data[[i]]$showlegend = FALSE}  # sometimes plotly adds to the legend values that we don't want, this is how to get rid of them, too
}

ggp %>% config(displaylogo = FALSE, modeBarButtonsToRemove = list("autoScale2d", "resetScale2d","select2d", "lasso2d", "zoomIn2d", "zoomOut2d", "toggleSpikelines", "zoom2d", "pan2d"))

ggp

有人对此有一个优雅的解决方案吗？ 谢谢

Answer 1

不要在geom_point 中为第二个数据框df2 定义文本。然后，您将只获得这两个点的一个工具提示。

  ggp <- ggplotly(ggplot(data = df, aes(x=Timeperiod, y=Value, group = AreaName, colour = AreaName, text = paste("Area name: ", AreaName, "<br>Time period: ", Timeperiod, "<br>Rate: ", round(Value,1), "per 100,000"))) +
                    geom_line() +
                    geom_point() +
                    geom_point(data = df2, aes(shape = c(paste(AreaName, qtr, Timeperiod)) #,
                                               #text = paste("Area name: ", AreaName, "<br>Quarter: ", qtr, "<br>Time period: ", Timeperiod, "<br>Rate: ", round(Value,1), "per 100,000")
                                               )) +
                    scale_shape_manual(values = c(18, 17)) +
                    theme(axis.text.x = element_text(vjust = 0.5), axis.title.x = element_blank()) +
                    labs(y = "Crude rate per 100,000 persons all ages", colour = "Area", shape = "") +
                    guides(shape = guide_legend(order = 2),colour = guide_legend(order = 1)) +
                    expand_limits(y=0), tooltip = "text")
  
  ggpNames <- unique(df$AreaName)
  legs <- paste(df2$AreaName, df2$qtr, df2$Timeperiod)
  ggpNames <- c(ggpNames,legs)
  
  for (i in 1:length(ggp$x$data)) { # this goes over all places where legend values are stored
    n1 <- ggp$x$data[[i]]$name # and this is how the value is stored in plotly
    n2 <- " "
    for (j in 1:length(ggpNames)) {
      if (grepl(x = n1, pattern = ggpNames[j])) {n2 = ggpNames[j]} # if the plotly legend name contains the original value, replace it with the original value
    }
    ggp$x$data[[i]]$name <- n2 # now is the time for actual replacement
    if (n2 == " ") {ggp$x$data[[i]]$showlegend = FALSE}  # sometimes plotly adds to the legend values that we don't want, this is how to get rid of them, too
  }
  
  ggp %>% config(displaylogo = FALSE, modeBarButtonsToRemove = list("autoScale2d", "resetScale2d","select2d", "lasso2d", "zoomIn2d", "zoomOut2d", "toggleSpikelines", "zoom2d", "pan2d"))
  
  ggp