7

I have an existing covariance matrix and I would like to convert it to become block diagonal based on which groups the individual columns belong to (e.g. 1st 2 rows/columns are group 1, next are group 2 etc.) Is there a simple way of doing this:

Below is an example of what I have:

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

I have 2 groups:

Group 1: 'a', 'b'

Group 2: 'c', 'd'

and what I would like:

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

5 Answers 5

7

Using a for loop.

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

We could use using logical indexing using the which function: With which we set the elements outside of each group to 0 using logical indexing. So we do not need a loop. This could be more efficient in larges matrices.


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
0
5

Here is a way.

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

Created on 2023-03-17 with reprex v2.0.2

0
5

We can use tcrossprod + table + stack to create a mask matrix, e.g.,

> 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

such that

> 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

where

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

You could use the linpk package with blockdiag function where you use two subsets of the groups you want like this:

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

Created on 2023-03-17 with reprex v2.0.2

3
  • 1
    Nice and short solution, appreciate it!!!
    – Tartaglia
    Mar 20 at 0:28
  • 1
    How would I modify this if I have 3 groups?
    – Tartaglia
    Mar 20 at 1:01
  • 1
    I think I got it, nevermind, just had to add the respective blocks as arguments)
    – Tartaglia
    Mar 20 at 2:43

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.