如何在 plotly 中自定义 hover window?
How to customize hover window in plotly?
我的 df 有两个数值变量(正值和负值)和 2 个分类变量。因为我想绘制具有相同颜色的负条 shape/boundaries 我在数据框中手动指定颜色并使用下面的代码。但是当我在条形图上移动鼠标时,信息显示不正确,所以我可以在 ggplotly 中自定义悬停吗?
df <- data.frame(model = c("A","B","C","D","B","C"),
category = c("origin", "origin","origin","abroad","abroad","abroad"),
pos = c(40,50,45,100,105,80),
neg = c(-10,-5,-4,-16,-7,-2),
Colour = c("chocolate","deeppink4","yellow","steelblue3","deeppink4","yellow"))
Colour <- as.character(df$Colour)
Colour <- c(Colour,"white")
names(Colour) <- c(as.character(df$model),"white")
df <- df %>% pivot_longer(., cols=c('pos','neg'),
names_to = 'sign') %>%
mutate(Groups = paste(category, model),
sign = factor(sign, levels = c("neg", "pos")))
plot <- ggplot() +
# plot positive with fill and colour based on model
geom_col(aes(value, tidytext::reorder_within(model, value, category),
fill = model, color = model),
data = df[df$sign == "pos", ],
position = "stack") +
# plot negative with colour from based on model, but fill fixed as "white"
geom_col(aes(value, tidytext::reorder_within(model, value, category),
color = model),
data = df[df$sign == "neg", ],
fill = "white",
position = "stack") +
# the rest is same as OP's code
tidytext::scale_y_reordered() +
labs(fill = "model") +
facet_grid(category ~ ., switch = "y",scales = "free_y") +
theme(axis.text.x = element_text(angle = 90),
strip.background = element_rect(fill = "white"),
strip.placement = "outside",
strip.text.y.left = element_text(angle = 0),
panel.spacing = unit(0, "lines")) +
theme(legend.position="none") +
labs( title = "BarPlot",
subtitle = "changes",
y = " ")
ggplotly(plot)
我不太清楚您希望标签的外观。我尝试提供足够的代码注释,以便您可以根据需要进行调整。
为了改变这个情节,我开始在 ggplot
对象上使用 plotly_build
。然后我从每个跟踪的现有文本中提取重要元素:模型、类别和值。然后我重新组合了信息并将其重新注入到情节中。
plt <- plotly_build(plot)
invisible(
lapply(1:length(plt$x$data),
function(i){
tx <- plt$x$data[[i]]$text
tr <- strsplit(tx, "<br />")
mo <- strsplit(tr[[1]][3], ": ")[[1]][2] # extract the model
ca <- strsplit(tr[[1]][2], "___")[[1]][2] # extract the category
va <- strsplit(tr[[1]][1], ": ")[[1]][2] # extract the value
str <- paste0("Model: ", mo, "<br />",
"Category: ", ca, "<br />",
"Value: ", va)
plt$x$data[[i]]$text <<- str # update the plot object
})
)
plt
我的 df 有两个数值变量(正值和负值)和 2 个分类变量。因为我想绘制具有相同颜色的负条 shape/boundaries 我在数据框中手动指定颜色并使用下面的代码。但是当我在条形图上移动鼠标时,信息显示不正确,所以我可以在 ggplotly 中自定义悬停吗?
df <- data.frame(model = c("A","B","C","D","B","C"),
category = c("origin", "origin","origin","abroad","abroad","abroad"),
pos = c(40,50,45,100,105,80),
neg = c(-10,-5,-4,-16,-7,-2),
Colour = c("chocolate","deeppink4","yellow","steelblue3","deeppink4","yellow"))
Colour <- as.character(df$Colour)
Colour <- c(Colour,"white")
names(Colour) <- c(as.character(df$model),"white")
df <- df %>% pivot_longer(., cols=c('pos','neg'),
names_to = 'sign') %>%
mutate(Groups = paste(category, model),
sign = factor(sign, levels = c("neg", "pos")))
plot <- ggplot() +
# plot positive with fill and colour based on model
geom_col(aes(value, tidytext::reorder_within(model, value, category),
fill = model, color = model),
data = df[df$sign == "pos", ],
position = "stack") +
# plot negative with colour from based on model, but fill fixed as "white"
geom_col(aes(value, tidytext::reorder_within(model, value, category),
color = model),
data = df[df$sign == "neg", ],
fill = "white",
position = "stack") +
# the rest is same as OP's code
tidytext::scale_y_reordered() +
labs(fill = "model") +
facet_grid(category ~ ., switch = "y",scales = "free_y") +
theme(axis.text.x = element_text(angle = 90),
strip.background = element_rect(fill = "white"),
strip.placement = "outside",
strip.text.y.left = element_text(angle = 0),
panel.spacing = unit(0, "lines")) +
theme(legend.position="none") +
labs( title = "BarPlot",
subtitle = "changes",
y = " ")
ggplotly(plot)
我不太清楚您希望标签的外观。我尝试提供足够的代码注释,以便您可以根据需要进行调整。
为了改变这个情节,我开始在 ggplot
对象上使用 plotly_build
。然后我从每个跟踪的现有文本中提取重要元素:模型、类别和值。然后我重新组合了信息并将其重新注入到情节中。
plt <- plotly_build(plot)
invisible(
lapply(1:length(plt$x$data),
function(i){
tx <- plt$x$data[[i]]$text
tr <- strsplit(tx, "<br />")
mo <- strsplit(tr[[1]][3], ": ")[[1]][2] # extract the model
ca <- strsplit(tr[[1]][2], "___")[[1]][2] # extract the category
va <- strsplit(tr[[1]][1], ": ")[[1]][2] # extract the value
str <- paste0("Model: ", mo, "<br />",
"Category: ", ca, "<br />",
"Value: ", va)
plt$x$data[[i]]$text <<- str # update the plot object
})
)
plt