Operation of matrix in R based on dimension names - r

Question

I have a symmetric matrix s defined as:
s<-matrix(1:25,5)
s[lower.tri(s)] = t(s)[lower.tri(s)]
dimnames(s) <- list(LETTERS[1:5], LETTERS[1:5])
s
A B C D E
A 1 6 11 16 21
B 6 7 12 17 22
C 11 12 13 18 23
D 16 17 18 19 24
E 21 22 23 24 25
In addition, there is a vector t defined as:
t <- seq(1,10)
names(t) <- c('C_A', 'E_A', 'E_B', 'E_C', 'E_D', 'D_A', 'D_B', 'D_C', 'C_B', 'A_B')
Now I would like to add the elements of t to the upper and lower triangular elements of s in such a way that the element of t with the name 'C_A' is added to the elements of s with row and column names of 'C' and 'A' (or 'A' and 'C'), the element of t with the name 'E_A' is added to the elements of s with row and column names of 'E' and 'A' (or 'A' and 'E'), etc. For example, both s['A','B'] and s['B','A'] should be added by t['A_B'], and similarly for all other off-diagonal elements. Do nothing for the diagonals.
What is an elegant way to achieve this?

Answer 1

This is not especially elegant but:
s<-matrix(1:25,5)
s[lower.tri(s)] = t(s)[lower.tri(s)]
dimnames(s) <- list(LETTERS[1:5], LETTERS[1:5])
t <- seq(1,10)
names(t) <- c('C_A', 'E_A', 'E_B', 'E_C', 'E_D', 'D_A', 'D_B', 'D_C', 'C_B', 'A_B')
s[t(do.call(cbind, strsplit(names(t), split = "_")))] <-
s[t(do.call(cbind, strsplit(names(t), split = "_")))] + t
s
#> A B C D E
#> A 1 16 11 16 21
#> B 6 7 12 17 22
#> C 12 21 13 18 23
#> D 22 24 26 19 24
#> E 23 25 27 29 25
To add the [i,j]th elements just call it again with the index positions reversed
s[t(do.call(cbind, strsplit(names(t), split = "_")))[,2:1]] <-
s[t(do.call(cbind, strsplit(names(t), split = "_")))[,2:1]] + t
s
#> A B C D E
#> A 1 16 12 22 23
#> B 16 7 21 24 25
#> C 12 21 13 26 27
#> D 22 24 26 19 29
#> E 23 25 27 29 25

Answer 2

Use outer to create row/col and col/row indexes, then overwrite the corresponding values of s:
sel1 <- match(names(t), outer(rownames(s),colnames(s), function(x,y) paste(x,y,sep="_")))
sel2 <- match(names(t), outer(rownames(s),colnames(s), function(x,y) paste(y,x,sep="_")))
s[sel1] <- s[sel1]+t
s[sel2] <- s[sel2]+t
# A B C D E
#A 1 16 12 22 23
#B 16 7 21 24 25
#C 12 21 13 26 27
#D 22 24 26 19 29
#E 23 25 27 29 25

Answer 3

Err: Will fix: You can use matrix indexing with a two-column matrix of character values for row and col:
nt <- strsplit(names(t), "_")
dnt <- data.frame(n=t, t(data.frame(nt)))
s[ as.matrix(dnt[-1]) ] <- s[ as.matrix(dnt[-1]) ] + t
s
#-----------
A B C D E
A 1 16 11 16 21
B 6 7 12 17 22
C 12 21 13 18 23
D 22 24 26 19 24
E 23 25 27 29 25
s[as.matrix(dnt[c(3,2)])] <- s[as.matrix(dnt[c(3,2)])] + t
s
#----------
A B C D E
A 1 16 13 28 25
B 26 7 30 31 28
C 12 21 13 34 31
D 22 24 26 19 34
E 23 25 27 29 25

Answer 4

t1 <- as.list(t)
p <- for(i in 1 :length(t1))
{
nam <-unlist(strsplit(names(t1[i]),"_"))
s[nam[1],nam[2]]<- t[[i]]
s[nam[2],nam[1]]<- t[[i]]
}
> s
A B C D E
A 1 10 1 6 2
B 10 7 9 7 3
C 1 9 13 8 4
D 6 7 8 19 5
E 2 3 4 5 25