使用apply函数嵌套for循环

Question

我想知道是否有一种方法可以使用 apply 函数来执行以下矩阵填充？我读过 apply 比 for 循环更有效。出于某种原因，我在 apply 函数系列中挣扎。

我正在寻找填充矩阵。我使用数据框中的数据作为数据填充的条件。

以下是数据逻辑示例；它被简化了，但涵盖了基于规则的人口的基本要素。

id_1 <- c(1, 1, 1, 1, 1, 1)
id_2 <- c(1, 1, 2, 2, 3, 3)
id_3 <- c(1, 2, 2, 3, 3, 4)
amt <- c(10, 15, 20, 25, 30, 35)

sample_data <- data.frame(id_1, id_2, id_3, amt)

n <- length(sample_data)

cor <- matrix(ncol = n, nrow = n)

i <- 1
j <- 1

for (i in 1:n) {
  for (j in 1:n) {
    if (i == j) {
      cor[i,j] = 1
    } else if (sample_data[2][i,] == sample_data[2][j,] & sample_data[3][i,] != sample_data[3][j,]) {
      cor[i,j] = 0
    } else if (sample_data[2][i,] != sample_data[2][j,] & sample_data[3][i,] == sample_data[3][j,]) {
      cor[i,j] = 0.5
    } else {
      cor[i,j] = 0.25
    }
  }
}

cor

     [,1] [,2] [,3] [,4]
[1,] 1.00 0.00 0.25 0.25
[2,] 0.00 1.00 0.50 0.25
[3,] 0.25 0.50 1.00 0.00
[4,] 0.25 0.25 0.00 1.00

Answer 1

apply 并不比 for 循环更有效，因此如果您正在寻找效率，这不是一个好方法。相反，您应该使用矢量化操作。让我们拆开你的 for 循环：

首先，如果元素在对角线上，则取值为 1，这可以通过 diag 函数实现：

diag(n)
#      [,1] [,2] [,3] [,4]
# [1,]    1    0    0    0
# [2,]    0    1    0    0
# [3,]    0    0    1    0
# [4,]    0    0    0    1

如果sample_data 的第二列中的条目 i 和 j 不匹配并且sample_data 的第三列中的条目 i 和 j 匹配，则非对角线条目 (i, j) 取值 0.5。这可以通过矢量化的outer 函数来实现：

topn.2 <- head(sample_data[,2], n)
topn.3 <- head(sample_data[,3], n)
0.5 * (outer(topn.2, topn.2, "!=") & outer(topn.3, topn.3, "=="))
#      [,1] [,2] [,3] [,4]
# [1,]    0  0.0  0.0    0
# [2,]    0  0.0  0.5    0
# [3,]    0  0.5  0.0    0
# [4,]    0  0.0  0.0    0

如果条目 i 和 j 在第 2 列和第 3 列中匹配或都不匹配，则非对角条目 (i, j) 取值为 0.25。同样，这可以通过outer 实现：

0.25 * (outer(1:n, 1:n, "!=") & (outer(topn.2, topn.2, "==") + outer(topn.3, topn.3, "==")) != 1)
#      [,1] [,2] [,3] [,4]
# [1,] 0.00 0.00 0.25 0.25
# [2,] 0.00 0.00 0.00 0.25
# [3,] 0.25 0.00 0.00 0.00
# [4,] 0.25 0.25 0.00 0.00

将所有内容加在一起会产生对 for 循环的完全矢量化替换：

diag(n) +
  0.5 * (outer(topn.2, topn.2, "!=") & outer(topn.3, topn.3, "==")) +
  0.25 * (outer(1:n, 1:n, "!=") & (outer(topn.2, topn.2, "==") + outer(topn.3, topn.3, "==")) != 1)
#      [,1] [,2] [,3] [,4]
# [1,] 1.00 0.00 0.25 0.25
# [2,] 0.00 1.00 0.50 0.25
# [3,] 0.25 0.50 1.00 0.00
# [4,] 0.25 0.25 0.00 1.00