ggplotly工具提示两次显示数据

时间:2020-11-03 15:54:11

标签: tooltip ggplotly

我使用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

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

1 个答案:

答案 0 :(得分:0)

请勿在{{1​​}}中为第二个数据帧geom_point定义文本。然后您将只获得针对这两个点的一个工具提示。

df2

output