使用 function 将结果保存在嵌套循环中

Question

我正在尝试使用 function 在嵌套循环 (4) 中获得结果，打印是正确的，但我无法在 dataframe 中获得结果。 我有这个：

for (t in 1:5)
  for (s in 1:5)
    for (j in 1:4)
      for (i in 1:2)
        print(c (t,s,j,i,function(j,t,s,i)))

哪个得到正确的结果，但我无法存储它，我试过：

c=c()
for (h in 1:200)
for (t in 1:5)
  for (s in 1:5)
    for (j in 1:4)
      for (i in 1:2)
        c[[h]] = c (t,s,j,i,function(j,t,s,i))
         return(c)

但是不行，谢谢。

Answer 1

当我们使用 NULL 向量进行初始化时，我们可以使用 append 而不是索引

c1 <- c()
for (h in 1:200){
   for (t in 1:5) {
      for (s in 1:5) {
        for (j in 1:4) {
           for (i in 1:2){
                 c1 <- c(c1, c(t,s,j,i,function(j,t,s,i)))
           }
          }
         }
         }
       }

注意： c是 function 名称，最好使用不同的 object 名称（'c1'）进行初始化

Answer 2

OP的原始尝试

您最初的尝试几乎就在那里：您只需要独立于嵌套循环推进索引h 。

在计算function的最内层循环的每次迭代中， h都会提前 1 以将此迭代的结果存储在下一个可用存储位置：

c1 <- c()
h <- 0L
for (t in 1:5)
  for (s in 1:5)
    for (j in 1:4)
      for (i in 1:2) {
        h <- h + 1L
        c1[[h]] = c(t, s, j, i, your_function(j, t, s, i))
      }

这将返回c1中的向量列表。 该列表包含 200 = 5 * 5 * 4 * 2 条目。

（顺便说一句， OP 自己的答案创建了一个 5 行 200 列的矩阵。）

替代方案：无循环

R 提供的功能可以在一个没有循环的 go 中获得结果。 以下所有三个变体的基本思想是首先创建t 、 s 、 j和i的所有组合，然后在这些输入数据上应用 function。

底座 R

eg <- expand.grid(t = 1:5, s = 1:5, j = 1:4, i = 1:2)
eg[, "f"] <- do.call(mapply, c(your_function, eg))

这将返回一个包含 5 列和 200 行的 data.frame。

tidyverse

library(dplyr)
library(tidyr)
library(purrr)
crossing(t = 1:5, s = 1:5, j = 1:4, i = 1:2) %>% 
  mutate(f = pmap_dbl(., your_function))

这将返回一个包含 5 列和 200 行的 tibble（增强的 data.frame）。

data.table

library(data.table)
CJ(t = 1:5, s = 1:5, j = 1:4, i = 1:2)[, .(t, s, j, i, f = your_function(j, t, s, i))]

这将返回一个具有 5 列和 200 行的 data.table（增强的 data.frame）。

基准测试

我很惊讶和失望地发现像akrun这样的高代表 SO 用户认真地建议使用 appending 而不是 indexing 。 例如， Patrick Burns 的书The R Inferno的第 2 章中讨论了增长对象被认为是低效和不好的做法。

当然，追加需要更少的输入，但最快的答案并不总是最好的。 这可以通过对不同问题规模的不同方法进行基准测试来验证。

下面的基准比较了执行时间和 memory 消耗

• 生长物体
  • 使用cbind()附加到矩阵（按列，如OP 自己的答案）
  • 使用rbind()附加到矩阵（逐行）
  • 使用c()附加到列表
• 索引
  • 在预先分配的矩阵中按列存储
  • 在预先分配的矩阵中逐行存储
  • 存储在列表中（在OP 的原始方法中尝试过）
• 没有循环使用
  • mapply() (基础 R)
  • pmap() (tidyverse)
  • data.table

为了对不同的问题规模进行基准测试， i上最内层循环的长度是不同的。

最后，我们需要定义一个易于评估的 function：

fct <- function(j, t, s, i) ((10*j + t)*10 + s)*10 + i

用于基准测试bench package。 检查结果已关闭，因为不同方法的结果在 class 和形状上有所不同。

library(bench)
library(ggplot2)
library(dplyr)
library(tidyr)
library(purrr)
library(data.table)
bm <- press(
  ni = 2L * 10^(0:2),
  {
    nt <- 5L
    ns <- 5L
    nj <- 4L
    ntsji <- nt * ns * nj * ni
    cat(ntsji, "\n")
    mark(
      grow_cbind = {
        c1 <- c()
        for (t in seq(nt)) 
          for (s in seq(ns)) 
            for (j in seq(nj)) 
              for (i in seq(ni)) {
                c1 <- cbind(c1, c(t, s, j, i, fct(j, t, s, i)))
        }
      },
      idx_col = {
        c1 <- matrix(nrow = 5L, ncol = ntsji)
        icol <- 0L
        for (t in seq(nt)) 
          for (s in seq(ns)) 
            for (j in seq(nj)) 
              for (i in seq(ni)) {
                icol <- icol + 1L
                c1[ , icol] <- c(t, s, j, i, fct(j, t, s, i))
              }
      },
      grow_rbind = {
        c1 <- c()
        for (t in seq(nt)) 
          for (s in seq(ns)) 
            for (j in seq(nj)) 
              for (i in seq(ni)) {
                c1 <- rbind(c1, c(t, s, j, i, fct(j, t, s, i)))
              }
      },
      idx_row = {
        c1 <- matrix(nrow = ntsji, ncol = 5L)
        irow <- 0L
        for (t in seq(nt)) 
          for (s in seq(ns)) 
            for (j in seq(nj)) 
              for (i in seq(ni)) {
                irow <- irow + 1L
                c1[irow, ] <- c(t, s, j, i, fct(j, t, s, i))
              }
      },
      grow_list = {
        c1 <- list()
        for (t in seq(nt)) 
          for (s in seq(ns)) 
            for (j in seq(nj)) 
              for (i in seq(ni)) {
                c1 <- c(c1, list(c(t, s, j, i, fct(j, t, s, i))))
              }
      },
      idx_list = {
        c1 <- list(ntsji)
        idx <- 0L
        for (t in seq(nt)) 
          for (s in seq(ns)) 
            for (j in seq(nj)) 
              for (i in seq(ni)) {
                idx <- idx + 1L
                c1[[idx]] <- c(t, s, j, i, fct(j, t, s, i))
              }
      },
      nol_mapply = {
        eg <- expand.grid(t = seq(nt), s = seq(ns), j = seq(nj), i = seq(ni))
        eg[, "f"] <- do.call(mapply, c(fct, eg))
      },
      nol_pmap = {
        crossing(t = seq(nt), s = seq(ns), j = seq(nj), i = seq(ni)) %>% 
          mutate(f = pmap_dbl(., fct))
      },
      nol_dt = {
        CJ(t = seq(nt), s = seq(ns), j = seq(nj), i = seq(ni))[
          , .(t, s, j, i, f = fct(j, t, s, i))]
      },
      check = FALSE
    )}
)

使用对数时间刻度绘制时间：

autoplot(bm)

图表显示，

• 与其他方法相比，随着问题规模的增加，增长的对象变得越来越慢。 对于最大的问题规模，它比一个数量级慢。
• output object 的创建方式（列表、矩阵列方式或矩阵行方式）对执行速度没有太大影响。
• data.table方法对于较大的问题规模是最快的。 对于最大的问题规模，它比第二快的速度快一个数量级以上，比生长对象快 3 个数量级（1000 倍）。

Memory 消耗在下面的mem_alloc列中显示：

print(bm, n = Inf)
# A tibble: 27 x 14
   expression    ni      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time
   <bch:expr> <dbl> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm>
 1 grow_cbind     2   1.58ms   1.88ms   484.     794.16KB     8.73   222     4   458.41ms
 2 idx_col        2   1.44ms   1.76ms   489.      12.12KB     6.58   223     3   455.64ms
 3 grow_rbind     2    1.7ms      2ms   445.     794.16KB    10.6    126     3   283.15ms
 4 idx_row        2   1.41ms   1.59ms   548.      11.81KB     6.37   258     3   471.22ms
 5 grow_list      2   1.34ms   1.59ms   574.     164.59KB     4.17   275     2   479.38ms
 6 idx_list       2   1.38ms   1.62ms   561.      29.95KB     6.37   264     3    470.7ms
 7 nol_mapply     2  714.4us  821.8us  1108.      15.64KB     8.52   520     4    469.3ms
 8 nol_pmap       2   7.25ms    8.7ms   111.      22.77KB     4.28    52     2   467.69ms
 9 nol_dt         2   1.58ms   1.99ms   460.      78.91KB     2.03   226     1   491.48ms
10 grow_cbind    20  21.86ms  23.24ms    38.0     76.42MB    69.7      6    11   157.74ms
11 idx_col       20    6.9ms   7.92ms   115.     117.59KB     6.53    53     3   459.29ms
12 grow_rbind    20  24.12ms  25.16ms    39.6     76.42MB    87.1      5    11   126.26ms
13 idx_row       20   6.67ms   7.77ms   118.     117.28KB     6.55    54     3   458.18ms
14 grow_list     20  21.36ms  23.13ms    42.7     15.36MB     7.11    18     3   421.72ms
15 idx_list      20   7.44ms   8.36ms   112.     333.92KB     6.59    51     3   455.35ms
16 nol_mapply    20   4.99ms   5.87ms   167.     142.55KB     9.02    74     4   443.29ms
17 nol_pmap      20  13.28ms   15.1ms    62.0    114.36KB     6.89    27     3    435.4ms
18 nol_dt        20   1.67ms    2.1ms   422.     198.44KB     2.05   206     1   488.67ms
19 grow_cbind   200     2.3s     2.3s     0.434    7.45GB    33.9      1    78       2.3s
20 idx_col      200  66.01ms  74.33ms    13.7      1.14MB     7.85     7     4   509.42ms
21 grow_rbind   200    2.43s    2.43s     0.412    7.45GB    32.1      1    78      2.43s
22 idx_row      200   65.9ms  75.92ms    13.6      1.14MB     7.78     7     4   514.05ms
23 grow_list    200    2.04s    2.04s     0.490    1.49GB     7.35     1    15      2.04s
24 idx_list     200  71.34ms   77.3ms    12.3       3.3MB     7.01     7     4   570.57ms
25 nol_mapply   200  52.63ms  64.19ms    14.8      1.48MB     9.26     8     5   540.07ms
26 nol_pmap     200  74.69ms  82.26ms    11.7      1.01MB     7.79     6     4   513.76ms
27 nol_dt       200   2.32ms   2.92ms   259.       1.36MB     1.99   130     1   501.78ms
# ... with 4 more variables: result <list>, memory <list>, time <list>, gc <list>

该表清楚地表明

• 增长的对象比其他方法分配更多的 memory。 对于最大的问题规模，增长矩阵分配的 memory 比索引或无循环方法多 7000 倍。

Session 信息

摘自

sessioninfo::session_info()

 - Session info ------------------------------------------------------------------------- setting value version R version 4.0.0 (2020-04-24) os Windows 10 x64 system x86_64, mingw32 ui RStudio - Packages ----------------------------------------------------------------------------- package * version date lib source bench * 1.1.1 2020-01-13 [1] CRAN (R 4.0.0) data.table * 1.12.9 2020-05-26 [1] local dplyr * 1.0.0 2020-05-29 [1] CRAN (R 4.0.0) ggplot2 * 3.3.1 2020-05-28 [1] CRAN (R 4.0.0) purrr * 0.3.4 2020-04-17 [1] CRAN (R 4.0.0) tidyr * 1.1.0 2020-05-20 [1] CRAN (R 4.0.0)

Answer 3

合作过

c1 <- c()
for (t in 1:t) {
  for (s in 1:s) {
    for (j in 1:4) {
      for (i in 1:2){
        c1 <- cbind(c1, c(t,s,j,i,function(j,t,s,i)))
      }
    }
  }
}

@akrun 破解