如何使绘图树形图在将鼠标悬停在其上时显示其绘制的“节点”的标签？

Question

我正在尝试建立一种原型方法，用 R 中的树状图来显示树数据结构（或者至少是它的变通版本），它代表历史工作流程。我已经让树形图正常工作了，但是，是否可以显示有关每个节点/分支位置的自定义信息？

这是我的代码：

library(plotly)
library(ggplot2)
library(ggdendro)
library(shiny)

find_lca <- function(parents, depth, node1, node2) {
  # Find the depths of the nodes
  depth1 <- depth[node1]
  depth2 <- depth[node2]
  
  # Make sure node1 is at a higher depth
  if (depth1 < depth2) {
    temp <- node1
    node1 <- node2
    node2 <- temp
  }
  
  # Adjust the depth of node1
  depth_diff <- depth1 - depth2
  while (depth_diff > 0) {
    node1 <- parents[node1]
    depth_diff <- depth_diff - 1
  }
  
  # Check if node1 and node2 are already the same
  if (node1 == node2) {
    return(node1)
  }
  
  # Move up both nodes until they have a common parent
  while (parents[node1] != parents[node2]) {
    node1 <- parents[node1]
    node2 <- parents[node2]
  }
  
  # Return the lowest common ancestor
  return(parents[node1])
}

calculate_distance <- function(parent.of.index, distance.from.root, child_a_index, child_b_index) {
  
  # Calculate the distance between root and n1
  dist_n1_root <- distance.from.root[[child_a_index]]
  # Calculate the distance between root and n2
  dist_n2_root <- distance.from.root[[child_b_index]]
  
  # Calculate the distance between n1 and n2
  dist_n1_n2 <- distance.from.root[[find_lca(parent.of.index, distance.from.root, child_a_index, child_b_index)]]
  # Calculate the final distance using the formula
  final_distance <- dist_n1_root + dist_n2_root - 2 * dist_n1_n2
  
  return(final_distance)
}


state <- list(1, 2, 3, 4, 5)
actions = list( list(label = "Action 1", variables = state[1]), 
                list(label = "Action 2", variables = state[2]), 
                list(label = "Action 3", variables = state[3]), 
                list(label = "Action 4", variables = state[4]), 
                list(label = "Action 5", variables = state[5]) 
)
parent.of.index = c(-1, 1, 1, 3, 3)
depth = c(0, 1, 1, 2, 2)

dendro_data <- data.frame(
  child_b = c()
)


for (i in 2:length(actions)) {
  for (j in 1:(i-1)) {
    child_a <- i
    child_b <- j
    #child_b is ALWAYS smaller/higher/earlier than child_a
    distance <- calculate_distance(parent.of.index, depth, child_a, child_b)
    dendro_data[i, j] = distance
  }
}

dendro_data <- dendro_data[-1, ]
colnames(dendro_data) <- state[-length(state)]

temp = as.vector(na.omit(unlist(dendro_data)))
NM = unique(c(colnames(dendro_data), row.names(dendro_data)))
mydist = structure(temp, Size = length(NM), Labels = NM,
                   Diag = FALSE, Upper = FALSE, method = "euclidean", #Optional
                   class = "dist")
model <- hclust(mydist)
dhc <- as.dendrogram(model)

data <- dendro_data(dhc, type = "triangle")
p <- ggplot(segment(data)) + 
  geom_segment(aes(x = x, y = y, xend = xend, yend = yend)) + 
  scale_y_reverse(expand = c(0.2, 0)) +
  theme_dendro()

ggplotly(p)

是的，我知道代码很混乱，我只是尽快将其拼凑在一起以进行原型设计。 处理数据的方式是我有一个列表，其中包含当前索引处节点的父节点的索引（标记为父节点），并且有一个当前节点已采取的操作的列表，其中包含一个数据框

actions

由当前操作

label

的标签和迄今为止构成历史的操作组成。为了简单起见，“迄今为止的历史记录”只是一个名为

state

的数字列表

目前，剧情呈现如下：

如果可能的话，我想当我将鼠标悬停在黑框中时渲染

label

和

state

变量，我该怎么做？

Answer 1

library(plotly)
library(ggplot2)
library(ggdendro)
library(dplyr)

label(data) %>% 
  select(xend = x, label) %>% 
  right_join(segment(data)) %>% 
 ggplot() + 
  geom_segment(aes(x = x, y = y, xend = xend, yend = yend, 
                   text= ifelse(is.na(label), 
                                sprintf("x: %s<br>y: %s", x, y),
                                sprintf("x: %s<br>y: %s<br>Label: %s", x, y, label)))) + 
  scale_y_reverse(expand = c(0.2, 0)) +
  theme_dendro() -> p
#> Joining with `by = join_by(xend)`
#> Warning in geom_segment(aes(x = x, y = y, xend = xend, yend = yend, text =
#> ifelse(is.na(label), : Ignoring unknown aesthetics: text

ggplotly(p, tooltip = "text")

数据：

data <- structure(list(segments = structure(list(x = c(2.625, 2.625, 1.5, 1.5, 
                                                       3.75, 3.75, 4.5, 4.5), 
                                                 y = c(3, 3, 1, 1, 2, 2, 1, 1), 
                                                 xend = c(1.5, 3.75, 1, 2, 
                                                          3, 4.5, 4, 5), 
                                                 yend = c(1, 2, 0, 0, 0, 1, 0, 0)), 
                                             class = "data.frame", 
                                             row.names = c(NA, -8L)), 
                        labels = structure(list(x = c(1, 2, 3, 4, 5), 
                                                y = c(0, 0, 0, 0, 0), 
                                                label = c("1", "2", "5", "3", "4")), 
                                           class = "data.frame", 
                                          row.names = c(NA, -5L)), 
                        leaf_labels = NULL, 
                        class = "dendrogram"), 
                    class = "dendro")

^{创建于 2024-03-22，使用 reprex v2.0.2}