Мне нужно создать сеть из данных, которые выглядят примерно так:
library(dplyr)
df <- data_frame(
name = seq(0, 100, by = 1),
country = c(rep("France", 6), rep("Germany", 10), rep("UK", 14), rep("China", 20), rep("Japan", 10), rep("USA", 20), rep("Canada", 5), rep("Peru", 5),
rep("Global", 11)),
continent = c(rep("Europe", 30), rep("Asia", 30), rep("North America", 25), rep("South America", 5), rep("Global", 11))
)
df_links <- data_frame(
name1 = sample(seq(from = 0, to = 100, by = 1), size = 300, replace = TRUE),
name2 = sample(seq(from = 0, to = 100, by = 1), size = 300, replace = TRUE)
)
После небольшой обработки данных вот как выглядит сеть:
Код:
library(networkD3)
nodes <- data_frame(name = c(seq(0, 100, by = 1), unique(df$country), unique(df$continent))) %>% unique() %>% mutate(id = row_number() - 1) %>%
as.data.frame()
edges <- df %>%
select(name1 = country,
name2 = continent) %>%
rbind(df %>% select(name1 = name, name2 = country)) %>%
rbind(df_links) %>%
merge(nodes, by.x = "name1", by.y = "name") %>%
select(from = id, name2) %>%
merge(nodes, by.x = "name2", by.y = "name") %>%
select(from, to = id)
forceNetwork(Links = edges, Nodes = nodes, Source = "from", Target = "to",
NodeID = "name", Group = rep(1), bounded = FALSE, zoom = TRUE)
Это не совсем то, что я искал, поэтому я попытался задать более короткие ребра между узлами в одной стране и более длинные ребра на разных континентах:
nodes_country <- nodes %>%
merge(df, by = "name", all = TRUE) %>%
mutate(country = ifelse(is.na(country), name, country),
continent = ifelse(is.na(continent), name, continent)) %>%
mutate(continent = case_when(
.$continent %in% c("France", "Germany", "UK") ~ "Europe",
.$continent %in% c("China", "Japan") ~ "Asia",
.$continent %in% c("USA", "Canada") ~ "North America",
.$continent == "Peru" ~ "South America",
TRUE ~ continent
)) %>%
select(-name)
edges <- edges %>%
merge(nodes_country, by.x = "from", by.y = "id") %>%
mutate(country_from = country,
continent_from = continent) %>%
select(-country, -continent) %>%
merge(nodes_country, by.x = "to", by.y = "id") %>%
mutate(country_to = country,
continent_to = continent) %>%
select(-country, -continent) %>%
mutate(distance = case_when(
.$country_from == .$country_to ~ 1,
.$country_from != .$continent_to & .$continent_from == .$continent_to ~ 3,
.$continent_from != continent_to ~ 5
)) %>%
select(from, to, distance)
forceNetwork(Links = edges, Nodes = nodes, Source = "from", Target = "to",
NodeID = "name", Group = rep(1), bounded = FALSE, zoom = TRUE,
Value = "distance",
linkDistance = networkD3::JS("function(d) { return 100*d.value; }"))
Однако это не особо помогло:
Мои вопросы: 1. Как я могу указать расстояние как вектор?Когда я попробовал просто linkDistance = "distance"
, сеть не работала, и я не хочу менять ширину ребер.2. В идеале я хотел бы лучше организовать эту сеть визуально по странам.Любые предложения, как я мог это сделать?Мне не нужно использовать библиотеку networkD3
, мне просто нужно что-то совместимое с блестящим.
В сценарии идеального мира мне бы хотелось что-то, похожее на это: