Question

我已经创建了一个有效的代码，但我相信它可以通过替换 for 循环运行得更快。

旧版本（可随意跳过）

基本上，我有一个非常大的矩阵 D 和两个向量，pop 和 trainSetSongs。矩阵太大了，在这里重现它变得毫无意义，所以让我们使用随机数据：

D <- matrix(rnorm(44158666), ncol = 7199, nrow = 6134)
pop <- rnorm(6134)
trainSetSongs <- rnorm(7199)

我现在想创建一个名为 tibble 的 record2。下面的代码有效，但对于更多索引可能会很慢。

record <- tibble(r = numeric(), row = numeric(), col = numeric())

for (i in 1:100) {
  r <- c()
  DRow <- D[i,] %>%
    order()
  popi <- pop %>%
    nth(i)
  for (j in 1:50) {
    r <- c(r, trainSetSongs[DRow %>%
                             head(j)] %>%
             mean() - popi
    )
  }
  record <- record %>%
    add_row(r = abs(r), row = i, col = 1:50)
  #cat(paste0("\014", i))
}

record2 <- record %>%
  group_by(col) %>%
  summarise(r = mean(r))

基本上，record2 对使用的 D 中的每一列都有一个条目（并非全部都是因为那样太慢了）。第二列给出了一些复杂的东西，也许通过查看代码最好地理解。它是 i 中的第 pop 个值（i 标记此过程发生的 D 行）与j 中的 trainSetSongs 值。由于 trainSetSongs 的索引最初对应于 D 的列，因此选择的 trainSetSongs 的值是矩阵中具有最低值的值。因此，j 标记了此过程正在发生的列数。

我知道这很令人困惑（至少，对我来说是这样；我经常发现自己在思考这一切意味着什么）。我的目标是拥有一段不使用 for 循环的代码（或者不使用它们那么多？），也许是通过真正使用 apply、transmute 或其他类似的功能。

编辑：新版本

阅读评论后，我尽我所能改进了代码，但我不知道如何绕过add_row()，而且我也认为有很多方法可以改进这段代码我没有想到.

如评论中所建议，测试数据缩减为：

set.seed(123)

D <- matrix(rnorm(50*20), ncol = 50, nrow = 20)
pop <- rnorm(20)
trainSetSongs <- rnorm(50)

for 的部分现在已经明显更快了，但仍然使用 add_row 和两个 for 循环。我不知道如何提高效率...

record <- tibble(r = numeric(), row = numeric(), col = numeric())

for (i in 1:20) {
  r <- rep(0, 50)
  DRow <- order(D[i,])
  popi <- pop[i]
  for (j in 1:50) {
    r[j] <- mean(trainSetSongs[head(DRow,j)]) - popi
  }
  record <- record %>%
    add_row(r = abs(r), row = i, col = 1:50)
}

其余代码完全相同。我还决定对数据进行很好的可视化：

record2 <- record %>%
  group_by(col) %>%
  summarise(r = mean(r))

ggplot(record2, aes(x = col, y = r))+
  geom_line(alpha = 0.5)+
  theme_minimal()+
  xlab("Number of Training Songs")+
  ylab("R")

使用这个种子和这个代码，可视化图产生一些可以在以后更容易比较的东西。

Answer 1

我花了一些时间来分解您的代码，但在此之前，这是更小（更快）的代码：

set.seed(123)
D <- matrix(rnorm(50*20), ncol = 50, nrow = 20)
pop <- rnorm(20)
trainSetSongs <- rnorm(50)

cols <- seq_len(ncol(D))
record2 <- lapply(seq_len(nrow(D)), function(i) {
  r <- cummean(trainSetSongs[order(D[i,])]) - pop[i]
  tibble(r = abs(r), row = i, col = cols)
})
record2 <- bind_rows(record2)

运行后，我测试准确性：

all.equal(record, record2)
# [1] TRUE

分解，从内而外的代码：

for (j..) 内循环实际上只是计算 trainSetSongs(order(D[i,])) 的累积平均值，然后减去特定的 pop 值，因此我们可以使用 cummean 函数而不是 for 循环。循环本身还不错，但 R 做这样的事情作为向量通常比循环快得多。为此，我们将内部 for 循环减少到只是
```
r <- cummean(trainSetSongs[order(D[i,])]) - pop[i]
```
（为了简单起见，我将赋值简化为 DRow 和 popi。这样做的效率并不低，所以如果您喜欢流程，可以随意创建这些变量并使用它们代替。）< /p>
我们对 D 的每一行重复该操作，但不是 for 循环一次追加一行，而是将每个新行分开，直到我们将它们全部收集为一个list，然后我们同时dplyr::bind_rows 将它们全部放在一起。这也可以通过在 list 循环中填充 for 来完成，例如
```
record2 <- list()
for (j in seq_len(nrow(D))) {
  # ...
  record2[[j]] <- tibble(...)
}
record2 <- bind_rows(record2)
```
（过去的情况是，for 循环在 R 中比 lapply 和 family 慢，但是自从解决这个问题已经好几年了，所以这些解决方案会奏效。）

如果你好奇，这个小数据的这种变化的基准是速度的两倍多：

# A tibble: 2 x 13
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory                     time          gc               
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list>                     <list>        <list>           
1 growing      31.7ms   32.4ms      30.8     764KB    185.      2    12     64.9ms <NULL> <Rprofmem[,3] [1,864 x 3]> <bch:tm [14]> <tibble [14 x 3]>
2 bindrows     14.3ms   14.9ms      66.3     119KB     25.3    21     8    316.8ms <NULL> <Rprofmem[,3] [279 x 3]>   <bch:tm [29]> <tibble [29 x 3]>

（从该基准测试中提取的两个很好的指标是 median，即执行相关表达式的中位时间；和 `itr/sec`，每秒迭代次数。注意中位时间是 32.4 毫秒，而 14.9女士）

如果我改为在 200x500 的 D 上运行相同的过程，改进会更加显着：

# A tibble: 2 x 13
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory                       time         gc              
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list>                       <list>       <list>          
1 growing       1.64s    1.64s     0.610   630.4MB    14.0      1    23      1.64s <NULL> <Rprofmem[,3] [289,664 x 3]> <bch:tm [1]> <tibble [1 x 3]>
2 bindrows   155.39ms 163.41ms     6.13      6.1MB     1.53     4     1   652.77ms <NULL> <Rprofmem[,3] [2,086 x 3]>   <bch:tm [4]> <tibble [4 x 3]>

相差 10 倍。我猜更大的数据会更快（相对）和更高效。

我们可以通过移除 tibble 部分并在 row 部分之后添加 col 和 lapply 来提高速度。如果您需要更高的速度，那就是一个起点。按照我的建议使用较大的 200x500 D，我们看到

# A tibble: 3 x 13
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory                       time          gc               
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list>                       <list>        <list>           
1 growing       1.39s    1.39s     0.721  630.39MB    0.721     1     1      1.39s <NULL> <Rprofmem[,3] [287,277 x 3]> <bch:tm [1]>  <tibble [1 x 3]> 
2 bindrows   164.97ms 260.44ms     3.84     7.24MB    1.92      2     1   520.87ms <NULL> <Rprofmem[,3] [2,091 x 3]>   <bch:tm [2]>  <tibble [2 x 3]> 
3 melt         9.89ms  11.06ms    87.1      7.32MB    0        44     0   505.29ms <NULL> <Rprofmem[,3] [1,062 x 3]>   <bch:tm [44]> <tibble [44 x 3]>

再提高 20 倍。那个代码，更高级一点，是

record3 <- abs(sapply(seq_len(nrow(D)), function(i) {
  cummean(trainSetSongs[order(D[i,])]) - pop[i]
}))
record3 <- setNames(reshape2::melt(record3), c("col", "row", "r"))
record3 <- record3[,c(3,2,1)]

这里，我们生成一个 matrix 而不是 list，所以在第一个 sapply 表达式之后，record3 是一个 500x200 矩阵（是的，dim 被交换，即好的）。从这里开始，reshape2::melt 将其转换为包含值及其列/行号的三列框架。

最后一行主要是装饰性的，但要像以前一样all.equal(record,record3)。

如何优化创建新数据框的循环

1 个答案: