根据行名和列名中的数字和字符串，对矩阵元素进行乘法运算（2）

Question

这个问题与我之前在这里提出的类似。我再次有一个非常大的矩阵，行和列名称相同。这些名称由三个字母的字符串后跟一个数字组成。三个字母的字符串重复出现，只有数字发生变化。经过几次重复之后，字符串更改并且数字从1开始。

基本上，我要根据每个元素的行名称和列名称进行具体计算。

下面是一个示例矩阵a：

matrix <- matrix(c(1:36), nrow = 6, byrow = TRUE)

names <- paste(rep(c("aaa" , "bbb", "ccc"), each = 2) , rep(c(1:2) , times = 3))

rownames(matrix) <- names
colnames(matrix) <- names

that gives:

      aaa 1 aaa 2 bbb 1 bbb 2 ccc 1 ccc 2
aaa 1     1     2     3     4     5     6
aaa 2     7     8     9    10    11    12
bbb 1    13    14    15    16    17    18
bbb 2    19    20    21    22    23    24
ccc 1    25    26    27    28    29    30
ccc 2    31    32    33    34    35    36

对于这个矩阵的每个元素，我想要进行乘法运算。用语言描述有些困难。

如果矩阵的一个元素的行名称与其列名称的三个字母字符串不同，我将匹配出现在该字符串后面的数字，并将“第一个三个字母字符串的数字”乘以“第二个三个字母字符串与相同数字”。

如果匹配 "aaa" 与 "bbb"，则：

matrix[aaa (number n), aaa (number m)] * matrix[bbb (number n), bbb (number m)]

如果"aaa"等于"aaa"，那么

matrix[aaa (number n), aaa (number m)] * matrix[aaa (number n), aaa (number m)]

或者基本上是元素的平方。

下面我将举一些例子，说明我的要求：

- 在矩阵matrix["aaa 1", "aaa 2"]中，我会将matrix["aaa 1", "aaa 2"]乘以matrix["aaa 1", "aaa 2"]（2*2），得到4。 - 在矩阵matrix["aaa 1", "bbb 2"]中，我会将matrix["aaa 1", "aaa 2"]乘以matrix["bbb 1", "bbb 2"]（2*16），得到32。 - 在矩阵matrix["bbb 2", "ccc 1"]中，我会将matrix["bbb 2", "bbb 1"]乘以matrix["ccc 2", "ccc 1"]（21*35），得到735。

最终，矩阵（称为d）应该如下所示：

      aaa 1 aaa 2 bbb 1 bbb 2 ccc 1 ccc 2
aaa 1     1     4    15    32    29    60
aaa 2    49    64   147   176   245   288
bbb 1    15    32   225   256   435   480
bbb 2   147   176   441   484   735   792
ccc 1    29    60   435   480   841   900
ccc 2   245   288   735   792  1225  1296

我用一些糟糕的代码得到了它：

d <- matrix^2

d[1,3] <- matrix[1,1] * matrix[3,3]
d[1,4] <- matrix[1,2] * matrix[3,4]
d[1,5] <- matrix[1,1] * matrix[5,5]
d[1,6] <- matrix[1,2] * matrix[5,6]
d[2,3] <- matrix[2,1] * matrix[4,3]
d[2,4] <- matrix[2,2] * matrix[4,4]
d[2,5] <- matrix[2,1] * matrix[6,5]
d[2,6] <- matrix[2,2] * matrix[6,6]

d[3,1] <- matrix[3,3] * matrix[1,1]
d[3,2] <- matrix[3,4] * matrix[1,2]
d[3,5] <- matrix[3,3] * matrix[5,5]
d[3,6] <- matrix[3,4] * matrix[5,6]
d[4,1] <- matrix[4,3] * matrix[2,1] 
d[4,2] <- matrix[4,4] * matrix[2,2]
d[4,5] <- matrix[4,3] * matrix[6,5]
d[4,6] <- matrix[4,4] * matrix[6,6]

d[5,1] <- matrix[5,5] * matrix[1,1]
d[5,2] <- matrix[5,6] * matrix[1,2]
d[5,3] <- matrix[5,5] * matrix[3,3]
d[5,4] <- matrix[5,6] * matrix[3,4]
d[6,1] <- matrix[6,5] * matrix[2,1]
d[6,2] <- matrix[6,6] * matrix[2,2]
d[6,3] <- matrix[6,5] * matrix[4,3]
d[6,4] <- matrix[6,6] * matrix[4,4]

有没有一种循环或其他方式可以更有效地解决这个问题的代码？

- Adrian

---

“aaa”与“bbb”匹配是什么意思？另外，“d <- c^2”也不清楚。 - akrun

我是指将行名称与列名称匹配。 - Adrian

每当行和列名称具有相同的三个字母字符串时，元素将会自乘。这种情况发生在沿对角线的2x2块中。 - Adrian

谢谢您提供更多的信息。现在有点忙，稍后会查看。 - akrun

也许你应该重新格式化你的数据才能完成这个任务。 - F. Privé

@Adrian，为什么你对你之前的问题的答案不满意？ - minem

Answer 1

循环语句中存在的脏数据：

d2 <- matrix^2
for (i in rownames(matrix)) {
  for (j in colnames(matrix)) {
    i1 <- strsplit(i, ' ', fixed = T)[[1]]
    j1 <- strsplit(j, ' ', fixed = T)[[1]]
    ni <- c(i1[2], j1[2])
    n1 <- paste(i1[1], ni)
    n2 <- paste(j1[1], ni)
    d2[i, j] <- matrix[n1[1], n1[2]] * matrix[n2[1], n2[2]]
  }
}

d2
#       aaa 1 aaa 2 bbb 1 bbb 2 ccc 1 ccc 2
# aaa 1     1     4    15    32    29    60
# aaa 2    49    64   147   176   245   288
# bbb 1    15    32   225   256   435   480
# bbb 2   147   176   441   484   735   792
# ccc 1    29    60   435   480   841   900
# ccc 2   245   288   735   792  1225  1296
all.equal(d2, d)
# [1] TRUE

这样会更快（无需循环）：

require(data.table)
require(Hmisc)
mat <- matrix # rename matrix variable,
# it is bad practice to name variables the same as internal functions
rn <- rownames(mat)
nn <- data.table(expand.grid(rn, rn, stringsAsFactors = F)) # all combinations of names
# split into parts:
nn[, Cs(v1, s1) := tstrsplit(Var1, ' ', fixed = T)]
nn[, Cs(v2, s2) := tstrsplit(Var2, ' ', fixed = T)]

# make respective new names:
nn[, a1 := paste(v1, s1)]
nn[, a2 := paste(v1, s2)]
nn[, b1 := paste(v2, s1)]
nn[, b2 := paste(v2, s2)]

index <- as.matrix(nn[, lapply(.SD, match, rn),
                      .SDcols = Cs(a1, a2, b1, b2)]) # get indexes of elements

d3 <- mat[index[, 1:2]] * mat[index[, 3:4]] # selection of elements and multiplication
d3 <- matrix(d3, ncol = ncol(mat)) # convert to matrix
rownames(d3) <- rn
colnames(d3) <- rn

all.equal(d3, d2)
# [1] TRUE

- minem

Answer 2

我们可以在这里使用mapply。

#Get all the possible combination of rownames and column names
all_combns <- expand.grid(rownames(matrix), colnames(matrix),
                   stringsAsFactors = FALSE)

matrix[] <- mapply(function(x, y) {
        #Extract first three letters
        first_group <- substr(x, 1, 3)
        second_group <- substr(y, 1, 3)

        #Extract the numeric part which could also be done in this example by
        #substr(x, 5, 5)
        #I am just extracting the numeric part in the string.
        first_num <- sub("[^\\d]+", "", x, perl = TRUE)
        second_num <- sub("[^\\d]+", "", y, perl = TRUE)

        #Construct element 1 and multiply it by elemnt 2
        matrix[paste(first_group, first_num),paste(first_group, second_num)] *
        matrix[paste(second_group, first_num),paste(second_group, second_num)]
        } , all_combns[, 1], all_combns[, 2])

matrix

#      aaa 1 aaa 2 bbb 1 bbb 2 ccc 1 ccc 2
#aaa 1     1     4    15    32    29    60
#aaa 2    49    64   147   176   245   288
#bbb 1    15    32   225   256   435   480
#bbb 2   147   176   441   484   735   792
#ccc 1    29    60   435   480   841   900
#ccc 2   245   288   735   792  1225  1296

- Ronak Shah

Answer 3

使用tidyr和dplyr的另一种方法：

mat_df <- as.data.frame(matrix) 

mat_df <- gather(mat_df, col, Val)
mat_df$rows <-row.names(matrix)
mat_df <- unite(mat_df, "mult", c("rows", "col"), sep = " ", remove=F)

mat_df <- separate(mat_df, col, c("col_let", "col_fig"), remove=F)
mat_df <- separate(mat_df, rows, c("rows_let", "rows_fig"), remove=F)

mat_df <- unite(mat_df, "mult1", c("rows", "rows_let", "col_fig"), sep = " ", remove=F)
mat_df <- unite(mat_df, "mult2", c("col_let", "rows_fig", "col"), sep = " ", remove=F)

mat_df <- mat_df %>% 
  left_join(mat_df[, c("Val", "mult")], by= c("mult1" = "mult")) %>%
  left_join(mat_df[, c("Val", "mult")], by= c("mult2" = "mult")) %>%
  mutate(Final = Val*Val.y) %>%
  select(rows, col, Final)

matrix_new <- as.matrix(spread(mat_df, col, Final)[, -1])
rownames(matrix_new) <- names

- Nar