R语言 将现有Cov矩阵转换为块对角线

8ehkhllq  于 2023-03-20  发布在  其他
关注(0)|答案(5)|浏览(512)

我有一个现有的协方差矩阵,我想根据各个列所属的组(例如,前2行/列是组1,接下来是组2等)将其转换为块对角矩阵。是否有简单的方法可以做到这一点:
下面是我的一个例子:

m1 <- matrix(1:16, ncol=4, byrow=TRUE)
rownames(m1) <- colnames(m1 ) <- c('a', 'b', 'c', 'd')

   a  b  c  d
a  1  2  3  4
b  5  6  7  8
c  9 10 11 12
d 13 14 15 16

我有2个组:
第1组:“a”、“B”
第2组:“c”、“d”
以及我想要的

a  b  c  d
a  1  2  0  0
b  5  6  0  0
c  0  0 11 12
d  0  0 15 16
nimxete2

nimxete21#

使用for循环。

g <- list(c('a', 'b'), c('c', 'd'))
for (x in g) m1[!rownames(m1) %in% x, colnames(m1) %in% x] <- 0
m1
#   a b  c  d
# a 1 2  0  0
# b 5 6  0  0
# c 0 0 11 12
# d 0 0 15 16
0vvn1miw

0vvn1miw2#

我们可以使用which函数进行逻辑索引:对于which,我们使用逻辑索引将每个组之外的元素设置为0,因此不需要循环,这在大型矩阵中可能更有效。

group1 <- c('a', 'b')
group2 <- c('c', 'd')

# logical indices for all groups
idx_group1 <- which(colnames(m1) %in% group1)
idx_group2 <- which(colnames(m1) %in% group2)

m1[-idx_group1, idx_group1] <- 0
m1[idx_group1, -idx_group1] <- 0
m1[-idx_group2, idx_group2] <- 0
m1[idx_group2, -idx_group2] <- 0

m1
a b  c  d
a 1 2  0  0
b 5 6  0  0
c 0 0 11 12
d 0 0 15 16
ruyhziif

ruyhziif3#

这里有一个办法。

fun <- function(x, groups) {
  y <- matrix(0, nrow(x), ncol(x), dimnames = dimnames(x))
  for(i in seq_along(groups)) 
    y[groups[[i]], groups[[i]]] <- 1L
  x * y
}

m1 <- matrix(1:16, ncol=4, byrow=TRUE)
rownames(m1) <- colnames(m1 ) <- c('a', 'b', 'c', 'd')
group1 <- c("a", "b")
group2 <- c("c", "d")

fun(m1, list(group1, group2))
#>   a b  c  d
#> a 1 2  0  0
#> b 5 6  0  0
#> c 0 0 11 12
#> d 0 0 15 16

创建于2023年3月17日,使用reprex v2.0.2

lawou6xi

lawou6xi4#

您可以将linpk包与blockdiag函数结合使用,其中使用所需组的两个子集,如下所示:

m1 <- matrix(1:16, ncol=4, byrow=TRUE)
rownames(m1) <- colnames(m1 ) <- c('a', 'b', 'c', 'd')
library(linpk)
blockdiag(m1[c("a", "b"), c("a", "b")], m1[c("c", "d"), c("c", "d")])
#>   a b  c  d
#> a 1 2  0  0
#> b 5 6  0  0
#> c 0 0 11 12
#> d 0 0 15 16

创建于2023年3月17日,使用reprex v2.0.2

cczfrluj

cczfrluj5#

我们可以使用tcrossprod + table + stack来创建掩码矩阵,例如,

> tcrossprod(table(stack(setNames(g, seq_along(g)))))
      values
values a b c d
     a 1 1 0 0
     b 1 1 0 0
     c 0 0 1 1
     d 0 0 1 1

使得

> m1 * tcrossprod(table(stack(setNames(g, seq_along(g)))))
  a b  c  d
a 1 2  0  0
b 5 6  0  0
c 0 0 11 12
d 0 0 15 16

其中

g <- list(c("a", "b"), c("c", "d"))

相关问题