Создание фреймов данных узлов и ребер из аккуратных фреймов данных

У меня есть фрейм данных этой структуры:

df <- data.frame(var1 = c(1,1,1,2,2,3,3,3,3),
                 cat1 = c("A","B","D","B","C","D","E","B","A"))`

> df
  var1 cat1
1    1    A
2    1    B
3    1    D
4    2    B
5    2    C
6    3    D
7    3    E
8    3    B
9    3    A

И я хочу создать из него кадры данных как узлов, так и краев, чтобы я мог нарисовать сетевой график, используя VisNetwork. Эта сеть покажет количество/силу соединений между различными значениями cat1, сгруппированными по значению var1.

У меня есть кадр данных узлов, отсортированный:

nodes <- data.frame(id = unique(df$cat1))
> nodes
  id
1  A
2  B
3  D
4  C
5  E

Я хотел бы помочь с тем, как обрабатывать df следующим образом: для каждого отдельного значения var1 в df подсчитайте группу узлов, которые являются общими для этого значения var1, чтобы получить кадр данных ребер, который в конечном итоге выглядит как один ниже. Обратите внимание, что меня не беспокоит направление потока по краям. Все, что мне нужно, это то, что они подключены.

> edges
  from to value
1    A  B     2
2    A  D     2
3    A  E     1
4    B  C     1
5    B  D     2
6    B  E     1
7    D  E     1

С благодарностью в ожидании, Невил

Обновление: я нашел здесь аналогичную проблему и адаптировал этот код, чтобы дать, который приближается к тому, что я хочу, но не совсем там...

    > df %>% group_by(var1) %>%
             filter(n()>=2) %>% group_by(var1) %>%
             do(data.frame(t(combn(.$cat1, 2,function(x) sort(x))), 
                           stringsAsFactors=FALSE))

# A tibble: 10 x 3
# Groups:   var1 [3]
    var1 X1    X2   
   <dbl> <chr> <chr>
 1    1. A     B    
 2    1. A     D    
 3    1. B     D    
 4    2. B     C    
 5    3. D     E    
 6    3. B     D    
 7    3. A     D    
 8    3. B     E    
 9    3. A     E    
10    3. A     B

r nodes edges networkd3
person Nevil    schedule 07.04.2018    source источник
comment
Здравствуйте, Сориф. Я думал, что показал кадр данных «края», который я пытаюсь создать из исходного df. Я что-то упускаю?   -  person Nevil    schedule 07.04.2018

Ответы (2)


arrow_upward
2
arrow_downward

Я не знаю, есть ли уже подходящая функция для решения этой задачи. Вот подробная процедура, как это сделать. При этом вы должны иметь возможность определить свою собственную функцию. Надеюсь, поможет!

# create an adjacency matrix
mat <- table(df)
mat <- t(mat) %*% mat 
as.table(mat) # look at your adjacency matrix
# since the network is not directed, we can consider only the (strictly) upper triangular matrix 
mat[lower.tri(mat, diag = TRUE)] <- 0
as.table(mat) # look at the new adjacency matrix

library(dplyr)
edges <- as.data.frame(as.table(mat))
edges <- filter(edges, Freq != 0)
colnames(edges) <- c("from", "to", "value")
edges <- arrange(edges, from)
edges # output

#  from to value
#1    A  B     2
#2    A  D     2
#3    A  E     1
#4    B  C     1
#5    B  D     2
#6    B  E     1
#7    D  E     1
person nghauran    schedule 07.04.2018

arrow_upward
1
arrow_downward

вот еще пару способов...

в базе Р...

values <- unique(df$var1[duplicated(df$var1)])

do.call(rbind,
  lapply(values, function(i) {
    nodes <- as.character(df$cat1[df$var1 == i])
    edges <- combn(nodes, 2)
    data.frame(from = edges[1, ],
               to = edges[2, ],
               value = i,
               stringsAsFactors = F)
  })
)

в тидиверсе...

library(dplyr)
library(tidyr)

df %>%
  group_by(var1) %>%
  filter(n() >= 2) %>%
  mutate(cat1 = as.character(cat1)) %>% 
  summarise(edges = list(data.frame(t(combn(cat1, 2)), stringsAsFactors = F))) %>%
  unnest(edges) %>% 
  select(from = X1, to = X2, value = var1)

в tidyverse с помощью tidyr::complete...

library(dplyr)
library(tidyr)

df %>%
  group_by(var1) %>%
  mutate(cat1 = as.character(cat1)) %>% 
  mutate(i.cat1 = cat1) %>% 
  complete(cat1, i.cat1) %>% 
  filter(cat1 < i.cat1) %>% 
  select(from = cat1, to = i.cat1, value = var1)

в tidyverse с использованием tidyr::expand...

library(dplyr)
library(tidyr)

df %>%
  group_by(var1) %>%
  mutate(cat1 = as.character(cat1)) %>%
  expand(cat1, to = cat1) %>% 
  filter(cat1 < to) %>% 
  select(from = cat1, to, value = var1)
person CJ Yetman    schedule 08.04.2018