向“visNetwork”添加附加信息

Question

使用 R，我创建了一些关于一组人及其相互关系的虚假数据：

#relationship data

Data_I_Have <- data.frame(
   
    "Node_A" = c("John", "John", "John", "Peter", "Peter", "Peter", "Tim", "Kevin", "Adam", "Adam", "Xavier"),
    "Node_B" = c("Claude", "Peter", "Tim", "Tim", "Claude", "Henry", "Kevin", "Claude", "Tim", "Henry", "Claude"),
    " Place_Where_They_Met" = c("Chicago", "Boston", "Seattle", "Boston", "Paris", "Paris", "Chicago", "London", "Chicago", "London", "Paris"),
  "Years_They_Have_Known_Each_Other" = c("10", "10", "1", "5", "2", "8", "7", "10", "3", "3", "5"),
  "What_They_Have_In_Common" = c("Sports", "Movies", "Computers", "Computers", "Video Games", "Sports", "Movies", "Computers", "Sports", "Sports", "Video Games")
)

#data about individuals

additional_data_about_people <- data.frame(
   
    "Person" = c("John", "Peter", "Tim", "Kevin", "Adam", "Xacier", "Claude", "Henry"),
   "Job" = c("Teacher", "Lawyer", "Accountant", "Engineer", "Teacher", "Lawyer", "Engineer", "Lawyer"),
"Age" = c("50", "51", "61", "56", "65", "65", "54", "50"),
"Favorite_Food" = c("pizza", "pizza", "tacos", "pizza", "ice cream", "sushi", "sushi", "pizza")
)

使用这些信息，我能够成功地制作一个表示这些人之间关系的图形网络：

library(igraph)
library(dplyr)
library(visNetwork)


graph_file <- data.frame(Data_I_Have$Node_A, Data_I_Have$Node_B)


colnames(graph_file) <- c("Data_I_Have$Node_A", "Data_I_Have$Node_B")

graph <- graph.data.frame(graph_file, directed=F)
graph <- simplify(graph)

plot(graph)

nodes <- data.frame(id = V(graph)$name, title = V(graph)$name)
nodes <- nodes[order(nodes$id, decreasing = F),]
edges <- get.data.frame(graph, what="edges")[1:2]

visNetwork(nodes, edges) %>%   visIgraphLayout(layout = "layout_with_fr") %>%
    visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE)

我想，如果我能在用户点击节点时显示每个人的信息，以及他们关系的详细信息（如果可能的话），那将会很有用。

我曾尝试在 R 中使用“visEvents”和“title”选项 (https://datastorm-open.github.io/visNetwork/nodes.html)，但我似乎无法弄清楚。有人可以告诉我怎么做吗？

谢谢

Answer 1

Data_I_Have <- data.frame(

  "Node_A" = c("John", "John", "John", "Peter", "Peter", "Peter", "Tim", "Kevin", "Adam", "Adam", "Xavier"),
  "Node_B" = c("Claude", "Peter", "Tim", "Tim", "Claude", "Henry", "Kevin", "Claude", "Tim", "Henry", "Claude"),
  "Place_Where_They_Met" = c("Chicago", "Boston", "Seattle", "Boston", "Paris", "Paris", "Chicago", "London", "Chicago", "London", "Paris"),
  "Years_They_Have_Known_Each_Other" = c("10", "10", "1", "5", "2", "8", "7", "10", "3", "3", "5"),
  "What_They_Have_In_Common" = c("Sports", "Movies", "Computers", "Computers", "Video Games", "Sports", "Movies", "Computers", "Sports", "Sports", "Video Games")
)

common_data = purrr::imap_dfc(dplyr::select(Data_I_Have, -Node_A, -Node_B), function(item, id){
  paste(id, "&colon; ", item)
})

common_strings = purrr::map_chr(seq(1, nrow(common_data)), function(in_row){
  paste(common_data[in_row, ], collapse = "<br>")
})

edge_data = dplyr::transmute(Data_I_Have, from = Node_A, to = Node_B, title = common_strings)

#data about individualsli

additional_data_about_people <- data.frame(

  "Person" = c("John", "Peter", "Tim", "Kevin", "Adam", "Xacier", "Claude", "Henry"),
  "Job" = c("Teacher", "Lawyer", "Accountant", "Engineer", "Teacher", "Lawyer", "Engineer", "Lawyer"),
  "Age" = c("50", "51", "61", "56", "65", "65", "54", "50"),
  "Favorite_Food" = c("pizza", "pizza", "tacos", "pizza", "ice cream", "sushi", "sushi", "pizza")
)


library(igraph)
library(dplyr)
library(visNetwork)


graph_file <- data.frame(Data_I_Have$Node_A, Data_I_Have$Node_B)


colnames(graph_file) <- c("Data_I_Have$Node_A", "Data_I_Have$Node_B")

graph <- graph.data.frame(graph_file, directed=F)
graph <- simplify(graph)

plot(graph)

add_field = purrr::imap_dfc(additional_data_about_people, function(item, id){
  paste0(id, "&colon; ", item)
})
additional_strings = purrr::map_chr(seq(1, nrow(add_field)), function(in_row){
  paste(add_field[in_row, ], collapse = "<br>")
})
additional_df = data.frame(id = additional_data_about_people$Person, title = additional_strings)
additional_df2 = dplyr::left_join(data.frame(id = V(graph)$name), additional_df, by = "id")


nodes <- data.frame(id = V(graph)$name, title = additional_df2$title)
nodes <- nodes[order(nodes$id, decreasing = F),]
edges <- get.data.frame(graph, what="edges")[1:2]

edges2 = dplyr::left_join(edges, edge_data, by = c("from", "to"))


visNetwork(nodes, edges2)

然后在悬停时，我会看到有关每个节点和边缘的附加信息。

这里要注意两点：

1. visNetwork 以 html 显示，因此您必须对特殊字符使用 html 代码，例如 <br> 用于返回，: 用于“:”。
2. 所有内容都可以具有显示为工具提示的“标题”属性，因此您也可以将其添加到边缘。

请注意，我创建了 data.frame，其中添加了属性以使其 看起来 字段与“：”类似，然后将它们全部粘贴在一起以显示实际标题。

希望以上内容有意义。

另外，修正你的代码，你在一个变量名前面有一个空格，这会对它做一些奇怪的事情。

至于在您单击它们时显示名称，目前这超出了我的能力范围。