创建绘图后是否可以修改 ggplotly 的悬停文本？

Question

假设我有三个农场的数据，这些农场生产不同种类的水果、蔬菜和浆果。我想比较所有这些并制作一个很酷的维恩图。然而，我还希望纳入关于其中每两个或所有农场哪些类型的产品是共同的数据。最好的事情是制作一个绘图小部件，该小部件将显示有多少组是常见的，而不是显示明显列出用于放置文本的数据点的文本（参见图片）。问题：是否可以在创建后修改 ggplotly 对象来实现此行为？理想情况下，我希望在深灰色框中看到“蔬菜、浆果”（因为这些是 B 和 C 之间共享的植物组），而不是现在显示的任何内容。

代码：

library(ggvenn)
library(plotly)
# Fruits
fruits <- c("Apple", "Banana", "Orange", "Mango", "Pineapple", "Peach", "Pear", "Grapefruit", "Lemon", "Kiwi")

# Vegetables
vegetables <- c("Carrot", "Broccoli", "Cauliflower", "Spinach", "Kale", "Potato", "Onion", "Garlic", "Cucumber", "Tomato")

# Berries
berries <- c("Strawberry", "Blueberry", "Raspberry", "Blackberry", "Cranberry", "Gooseberry", "Elderberry", "Mulberry", "Boysenberry", "Currant")

fvb <- c(fruits, vegetables, berries)
set.seed(344)
vennda <- list("A" = sample(fvb, 10),
     "B" = sample(fvb, 10),
     "C" = sample(fvb, 10))

gg <- ggvenn(vennda)
ggp <- ggplotly(gg)
ggp

结果图的图片：

Answer 1

嗯，我发现您可以非常轻松地访问悬停文本标签。剩下的只是弄清楚如何准备这些，所以这是我对此的答案，这似乎有效

all_items <- c(fruits, vegetables, berries)
all_categories <- c(rep("Fruits", length(fruits)), rep("Vegetables", length(vegetables)), rep("Berries", length(berries)))
item_to_category <- setNames(all_categories, all_items)
#sub-function for generating correct intersections
find_unique_elements <- function(lst) {
  lapply(seq_along(lst), function(i) {
    current_set <- lst[[i]]
    other_sets <- do.call(c, lst[-i])
    setdiff(current_set, other_sets)
  })
}
# Function to calculate all intersections
calculate_intersections <- function(sets) {
  n <- length(sets)
  combs <- lapply(1:n, function(i) combn(1:n, i, simplify = FALSE))
  intersections <- lapply(combs, function(comb_set) {
    lapply(comb_set, function(indices) {
      Reduce(intersect, sets[indices])
    }) %>% find_unique_elements()
  })
  return(do.call(c, intersections))
}

# Function to generate hover texts
generate_hover_texts <- function(intersections, item_to_category) {
  lapply(intersections, function(intersect_set) {
    categories <- unique(item_to_category[intersect_set])
    paste(categories, collapse = ", ")
  })
}

# Calculate all intersections
all_intersections <- calculate_intersections(vennda)

# Generate hover texts
hover_texts <- generate_hover_texts(all_intersections, item_to_category)

# Hoverlabels are stored in ggp$x$data[[6]]$hovertext, so let's update hover texts in the Plotly object
ggp$x$data[[6]]$hovertext <- hover_texts
ggp