создание полной матрицы смежности из частичной информации - PullRequest
Новая
       35

создание полной матрицы смежности из частичной информации

0 голосов
/ 19 февраля 2019

I have матрица, которая содержит всю информацию, необходимую для построения матриц смежности 5x5.Каждая строка представляет одну матрицу: 

     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,]    1    1    1    1    1    1    1    0    1     0
[2,]    0    0    0    1    1    1    1    0    1     0
...

I want, чтобы создать матрицу смежности из n-й строки данных.Для первой строки have матрица want будет выглядеть следующим образом: 

     [,1] [,2] [,3] [,4] [,5]
[1,]    0    1    1    1    1
[2,]    1    0    1    1    1
[3,]    1    1    0    0    1
[4,]    1    1    0    0    0
[5,]    1    1    1    0    0

Как мне получить от have до want?

1 Ответ

0 голосов
/ 19 февраля 2019

Здесь есть опция, использующая lower.tri и upper.tri

unlist(apply(mat, 1, function(x) {
    m <- matrix(0, nrow = 5, ncol = 5)
    m[lower.tri(m)] <- x
    m[upper.tri(m)] <- x
    list(m)
}), recursive = F)
#[[1]]
#     [,1] [,2] [,3] [,4] [,5]
#[1,]    0    1    1    1    1
#[2,]    1    0    1    1    0
#[3,]    1    1    0    1    1
#[4,]    1    1    0    0    0
#[5,]    1    1    1    0    0
#
#[[2]]
#     [,1] [,2] [,3] [,4] [,5]
#[1,]    0    0    0    1    1
#[2,]    0    0    0    1    0
#[3,]    0    1    0    1    1
#[4,]    0    1    0    0    0
#[5,]    1    1    1    0    0

. Часть unlist(..., recursive = F) кажется несколько неловкой, но она необходима для того, чтобы apply не упростил результат и не уменьшил яркость.В качестве альтернативы можно использовать lapply на data.frame вместо matrix: 

lapply(as.data.frame(t(mat)), function(x) {
    m <- matrix(0, nrow = 5, ncol = 5)
    m[lower.tri(m)] <- x
    m[upper.tri(m)] <- x
    return(m)
})

, дающего тот же результат.

Пример данных 

mat <- as.matrix(read.table(text =
"1    1    1    1    1    1    1    0    1     0
0    0    0    1    1    1    1    0    1     0", header = F))
colnames(mat) <- NULL
...