Визуализация сети R - объединение кругов упаковки и работы в сети - PullRequest
0 голосов
/ 16 октября 2018

Мне нужно создать сеть из данных, которые выглядят примерно так:

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)
)

После небольшой обработки данных вот как выглядит сеть: enter image description here

Код:

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; }"))

Однако это не особо помогло: enter image description here

Мои вопросы: 1. Как я могу указать расстояние как вектор?Когда я попробовал просто linkDistance = "distance", сеть не работала, и я не хочу менять ширину ребер.2. В идеале я хотел бы лучше организовать эту сеть визуально по странам.Любые предложения, как я мог это сделать?Мне не нужно использовать библиотеку networkD3, мне просто нужно что-то совместимое с блестящим.

В сценарии идеального мира мне бы хотелось что-то, похожее на это:

enter image description here

...