Объединение нескольких векторов узлов в список ребер и преобразование их в матрицу смежности - PullRequest
Новая
       40

Объединение нескольких векторов узлов в список ребер и преобразование их в матрицу смежности

0 голосов
/ 16 ноября 2018

Я хочу отобразить несколько кругов отношений (состоящих из списка id s) в большую матрицу смежности.Мои данные выглядят так: 

circle_1 = c(1, 3, 5)
circle_2 = c(17, 22, 35, 49)
circle_3 = c(2, 9)
circle_4 = c(12, 28, 33)
circle_5 = c(1, 3, 8, 16, 40)

d_mat = matrix(ncol = 2)

for (i in 1:5) {
#extract id from list
dat = get(paste("circle", i, sep="_"))
#convert to edgelist, each pair is unique
dat_t = t(combn(dat, 2))
#rbind edge list together
edge_list <- rbind(d_mat, dat_t)
}

Однако вывод edge_list возвращает только список ребер из последней итерации (circle_5) с перезаписанными предыдущими тремя.

Кроме того, предположим, что эти пять кружков были нарисованы из группы из 50 человек, как я могу сопоставить значения такого списка ребер с соответствующими ячейками матрицы смежности 50 на 50?(Я полагаю, что функции make_graph и as_adjacency_matrix в igraph должны делать трюки, но на данный момент я не знаю, как)circle_1 и circle_5, что означает, что 1 и 3 связаны дважды в этой сети из 50 человек.Как я могу объединить эту частоту счета и преобразовать матрицу смежности в взвешенную матрицу?

Ответы [ 2 ]

0 голосов
/ 16 ноября 2018

Я заимствую список вершин ('окружностей') из @gfgm и использую функции igraph.

Зацикливаем список вершин с помощью lapply.Для каждого набора вершин создайте полный граф (make_full_graph) с числом вершин n, равным длине вектора.Установите название вершин (V(g)$name).Преобразовать в «крайний список» (as_edgelist).rbind полученные матрицы.

library(igraph)
m <- do.call(rbind, lapply(circles, function(vert){
  g <- make_full_graph(n = length(vert))
  V(g)$name <- vert
  as_edgelist(g)
}))

Установить factor уровни вершин "от" и "до" и использовать table (аналогично @gfgm) 

tt <- table(factor(m[ , 1], levels = 1:50),
            factor(m[ , 2], levels = 1:50)) 

t[1:8, 1:16]
#   1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
# 1 0 0 2 0 1 0 0 1 0  0  0  0  0  0  0  1
# 2 0 0 0 0 0 0 0 0 1  0  0  0  0  0  0  0
# 3 0 0 0 0 1 0 0 1 0  0  0  0  0  0  0  1
# 4 0 0 0 0 0 0 0 0 0  0  0  0  0  0  0  0
# 5 0 0 0 0 0 0 0 0 0  0  0  0  0  0  0  0
# 6 0 0 0 0 0 0 0 0 0  0  0  0  0  0  0  0
# 7 0 0 0 0 0 0 0 0 0  0  0  0  0  0  0  0
# 8 0 0 0 0 0 0 0 0 0  0  0  0  0  0  0  1
0 голосов
/ 16 ноября 2018

Вы можете сделать это, как только начали, комбинируя списки ребер, а затем просто создать матрицу напрямую. 

circle_1 = c(1, 3, 5)
circle_2 = c(17, 22, 35, 49)
circle_3 = c(2, 9)
circle_4 = c(12, 28, 33)
circle_5 = c(1, 3, 8, 16, 40)

# lets put all the circles in a list for convenience
circles <- list(circle_1, circle_2, circle_3,
                circle_4, circle_5)

# we will lapply along the list, get the complete set of 
# edges with combn, and then rbind all the resulting
# structures together
edge_list <- do.call(rbind, lapply(circles, function(circ){t(combn(circ, 2))}))

# we convert to a data.frame and set the factor levels
# such that R knows these are nodes from a set of 50 nodes
edge_list <- data.frame(from = factor(edge_list[,1], levels=1:50),
                        to = factor(edge_list[,2], levels=1:50))
# take a look
head(edge_list)
#>   from to
#> 1    1  3
#> 2    1  5
#> 3    3  5
#> 4   17 22
#> 5   17 35
#> 6   17 49
# we can just use table to make the adjacency matrix. R will create
# a row/column for each level of the factor. We look at the first
# 6x6 entries
table(edge_list)[1:6,1:6] # luckily entry (1,3) = 2 as we hoped
#>     to
#> from 1 2 3 4 5 6
#>    1 0 0 2 0 1 0
#>    2 0 0 0 0 0 0
#>    3 0 0 0 0 1 0
#>    4 0 0 0 0 0 0
#>    5 0 0 0 0 0 0
#>    6 0 0 0 0 0 0

Эта матрица смежности является верхней треугольной. Если вы хотите, чтобы матрица смежности была симметричной как отражающая неориентированный граф, вы можете установить верхний и нижний треугольники матрицы равными, используя adj.mat[lower.tri(adj.mat)] <- adj.mat[upper.tri(adj.mat)].

Если вы хотите, чтобы матрица была просто двоичной (и не записывала несколько ссылок в разных кругах), просто запустите ее с помощью оператора ifelse: 

# to convert to purely binary
adj.mat <- table(edge_list)
adj.mat.bin <- ifelse(adj.mat>1, 1, adj.mat)
adj.mat.bin[1:6,1:6]
#>     to
#> from 1 2 3 4 5 6
#>    1 0 0 1 0 1 0
#>    2 0 0 0 0 0 0
#>    3 0 0 0 0 1 0
#>    4 0 0 0 0 0 0
#>    5 0 0 0 0 0 0
#>    6 0 0 0 0 0 0

Создано в 2018-11-16 пакетом Представление (v0.2.1)

...