如何在 r 中将嵌套循环转换为 lapply

Question

我有一个名为 "dahak" 的列表，其中包含 1 到 10 之间的 30000 个数字。我想用列表中的所有数字检查每个数字，如果两个数字相等，则将数字 1 附加到 weight_list，如果两个数字不相等，则计算它们的差值并将其存储为 x，并将 x 附加到 weight_list。这是代码：

for(j in 1:num_nodes){
  for (k in 1:num_nodes){
    if(j==k){
      weight_list <- c(weight_list,0)
    }
    else if(as.numeric(dahak[j])==as.numeric(dahak[k])){
      weight_list <- c(weight_list,1)
    }
    else if(as.numeric(dahak[j])!=as.numeric(dahak[k])){
      x = 1 - (abs(as.numeric(dahak[j]) - as.numeric(dahak[k])) / 10)
      weight_list <- c(weight_list,x)
    }
  }
}

我该如何优化这段代码？我如何用 lapply 做到这一点？

Answer 1

我想这可能是您正在寻找的简化，其中使用了 outer 和 ifelse。

下面是一个虚拟数据的例子：

set.seed(1)
num_nodes <- 15
dahak <- sample(10,num_nodes,replace = TRUE)

如果您想要 weigth_list 维度 num_nodes 的矩阵，那么您可以尝试

weight_list <- (u<-ifelse((z<-abs(outer(dahak,dahak,FUN = "-")))!=0,1-z/10,1))-diag(diag(u))

这样

> weight_list
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15]
 [1,]  0.0  0.5  0.8  0.2  0.3  0.8  0.3  0.4  0.2   0.6   0.6   0.9   0.7   0.9   0.8
 [2,]  0.5  0.0  0.7  0.7  0.8  0.7  0.8  0.9  0.7   0.9   0.9   0.4   0.8   0.4   0.7
 [3,]  0.8  0.7  0.0  0.4  0.5  1.0  0.5  0.6  0.4   0.8   0.8   0.7   0.9   0.7   1.0
 [4,]  0.2  0.7  0.4  0.0  0.9  0.4  0.9  0.8  1.0   0.6   0.6   0.1   0.5   0.1   0.4
 [5,]  0.3  0.8  0.5  0.9  0.0  0.5  1.0  0.9  0.9   0.7   0.7   0.2   0.6   0.2   0.5
 [6,]  0.8  0.7  1.0  0.4  0.5  0.0  0.5  0.6  0.4   0.8   0.8   0.7   0.9   0.7   1.0
 [7,]  0.3  0.8  0.5  0.9  1.0  0.5  0.0  0.9  0.9   0.7   0.7   0.2   0.6   0.2   0.5
 [8,]  0.4  0.9  0.6  0.8  0.9  0.6  0.9  0.0  0.8   0.8   0.8   0.3   0.7   0.3   0.6
 [9,]  0.2  0.7  0.4  1.0  0.9  0.4  0.9  0.8  0.0   0.6   0.6   0.1   0.5   0.1   0.4
[10,]  0.6  0.9  0.8  0.6  0.7  0.8  0.7  0.8  0.6   0.0   1.0   0.5   0.9   0.5   0.8
[11,]  0.6  0.9  0.8  0.6  0.7  0.8  0.7  0.8  0.6   1.0   0.0   0.5   0.9   0.5   0.8
[12,]  0.9  0.4  0.7  0.1  0.2  0.7  0.2  0.3  0.1   0.5   0.5   0.0   0.6   1.0   0.7
[13,]  0.7  0.8  0.9  0.5  0.6  0.9  0.6  0.7  0.5   0.9   0.9   0.6   0.0   0.6   0.9
[14,]  0.9  0.4  0.7  0.1  0.2  0.7  0.2  0.3  0.1   0.5   0.5   1.0   0.6   0.0   0.7
[15,]  0.8  0.7  1.0  0.4  0.5  1.0  0.5  0.6  0.4   0.8   0.8   0.7   0.9   0.7   0.0

Answer 2

听起来您想创建一个 30,000 x 30,000 的矩阵。它也听起来像 dahak 是一个向量而不是一个列表。如果那是真的你想做的，你可以简化你的逻辑并像这样矢量化；

get_weights <- function(x)  1 - abs(x - as.numeric(dahak))/10 
weights <- do.call(rbind, lapply(as.numeric(dahak), get_weights)) - diag(length(dahak))

使用与@ThomasIsCoding 相同的虚拟数据我得到：

weights
#>       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15]
#>  [1,]  0.0  0.9  0.7  0.3  1.0  0.4  0.3  0.6  0.6   0.8   1.0   0.9   0.6   0.9   0.5
#>  [2,]  0.9  0.0  0.8  0.4  0.9  0.5  0.4  0.7  0.7   0.7   0.9   0.8   0.7   1.0   0.6
#>  [3,]  0.7  0.8  0.0  0.6  0.7  0.7  0.6  0.9  0.9   0.5   0.7   0.6   0.9   0.8   0.8
#>  [4,]  0.3  0.4  0.6  0.0  0.3  0.9  1.0  0.7  0.7   0.1   0.3   0.2   0.7   0.4   0.8
#>  [5,]  1.0  0.9  0.7  0.3  0.0  0.4  0.3  0.6  0.6   0.8   1.0   0.9   0.6   0.9   0.5
#>  [6,]  0.4  0.5  0.7  0.9  0.4  0.0  0.9  0.8  0.8   0.2   0.4   0.3   0.8   0.5   0.9
#>  [7,]  0.3  0.4  0.6  1.0  0.3  0.9  0.0  0.7  0.7   0.1   0.3   0.2   0.7   0.4   0.8
#>  [8,]  0.6  0.7  0.9  0.7  0.6  0.8  0.7  0.0  1.0   0.4   0.6   0.5   1.0   0.7   0.9
#>  [9,]  0.6  0.7  0.9  0.7  0.6  0.8  0.7  1.0  0.0   0.4   0.6   0.5   1.0   0.7   0.9
#> [10,]  0.8  0.7  0.5  0.1  0.8  0.2  0.1  0.4  0.4   0.0   0.8   0.9   0.4   0.7   0.3
#> [11,]  1.0  0.9  0.7  0.3  1.0  0.4  0.3  0.6  0.6   0.8   0.0   0.9   0.6   0.9   0.5
#> [12,]  0.9  0.8  0.6  0.2  0.9  0.3  0.2  0.5  0.5   0.9   0.9   0.0   0.5   0.8   0.4
#> [13,]  0.6  0.7  0.9  0.7  0.6  0.8  0.7  1.0  1.0   0.4   0.6   0.5   0.0   0.7   0.9
#> [14,]  0.9  1.0  0.8  0.4  0.9  0.5  0.4  0.7  0.7   0.7   0.9   0.8   0.7   0.0   0.6
#> [15,]  0.5  0.6  0.8  0.8  0.5  0.9  0.8  0.9  0.9   0.3   0.5   0.4   0.9   0.6   0.0

如何在 r 中将嵌套循环转换为 lapply

how to convert a nested loop to lapply in r

r

nested-loops

lapply