在R中从一个函数创建多列（然后对它们求平均值）

Question

在R中从一个函数创建多列（然后对它们求平均值）

3

从以下开始:

dates <- yday(ceiling_date(dmy(sapply(1:11, function(x) paste0("01/", x, "/2009"))), "month") %m-% days(1))

foo <- data.frame(id = 1:1000000) %>%
  mutate(
    datdeb = round(runif(n(), 1, 365)),
    datfin = round(runif(n(), datdeb, 365)),
    etp = runif(n()),
    group = round(runif(n(), 1, 1000))
  )

我想要做的最基本的事情是：

for(i in 1:11){
  foo <- foo %>%
    group_by(group) %>%
    mutate(
      test = sum((dates[i] >= datdeb & dates[i] <= datfin))
    ) %>%
    rename(!!paste0("size_date", dates[i]) := "test")
}

res1 <- foo %>%
  mutate(
    m_size = rowMeans(across(starts_with("size_date")))
  ) %>%
  group_by(group) %>%
  summarise(
    m_size = mean(m_size)
  )

现在，我希望以最快的方式完成此操作，因为我要应用它的数据集非常庞大。

对于第一部分，我想到了以下替代方案：

foo <- bind_cols(foo, map_dfc(1:11, ~ foo %>%
                          group_by(group) %>%
                          transmute(!!paste0("size_date", dates[.x]) := sum((dates[.x] >= datdeb & dates[.x] <= datfin)))
                          ) %>% select(starts_with("size_date")))

但是令我有些惊讶的是，当使用tictoc进行基准测试时，这种方法结果比较慢。

针对第二部分，我提出了另外两个选项：

res2 <- foo %>%
  mutate(
    m_size = rowMeans(across(starts_with("size_date")))
  ) %>%
  group_by(group) %>%
  summarise(
    m_size = m_size[1]
  )

res3 <- foo %>%
  group_by(group) %>%
  slice(1) %>%
  mutate(
    m_size = rowMeans(across(starts_with("size_date")))
  )

毫不意外，最后一种选择速度要快得多。

我在想是否有更快（和更优雅？）的方法来完成这个任务？特别是，是否可以以增量累积均值的方式智能地将两个步骤结合起来？谢谢！

- Simon

你想保留在 tidyverse 中吗？因为更快的前进很可能意味着抛弃它。 - user10917479

你是否考虑使用data.table？我猜那也是个不错的选择，尽管我承认我经常会选择tidyverse，因为我喜欢它的可读性... - Simon

对于像这样的简单问题，您可以尝试使用 dtplyr。最好的两个世界... dplyr API 和 data.table 速度的结合。 - user10917479

是的！这已经在我的关注列表中了，但我还没有开始。它会严重影响速度吗？ - Simon

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- TimTeaFan · Accepted Answer

我有一个更加优雅的方法，但我怀疑它是否真正有效。一种做法是使用 purrr::map_dfc 并循环遍历 dates 向量。

library(tidyverse)
library(lubridate)

dates <- yday(ceiling_date(dmy(sapply(1:11, function(x) paste0("01/", x, "/2009"))), "month") %m-% days(1))

foo <- data.frame(id = 1:1000000) %>%
  mutate(
    datdeb = round(runif(n(), 1, 365)),
    datfin = round(runif(n(), datdeb, 365)),
    etp = runif(n()),
    group = round(runif(n(), 1, 1000))
  )

foo %>% 
  group_by(group) %>% 
  mutate(m_size = rowMeans(
    map_dfc(set_names(dates, dates),
            ~ sum(.x >= datdeb & .x <= datfin))
    )
  ) %>% 
  summarise(m_size = mean(m_size))
#> # A tibble: 1,000 x 2
#>    group m_size
#>    <dbl>  <dbl>
#>  1     1   141.
#>  2     2   258.
#>  3     3   298.
#>  4     4   283.
#>  5     5   286.
#>  6     6   274.
#>  7     7   263.
#>  8     8   273 
#>  9     9   272.
#> 10    10   261.
#> # … with 990 more rows

^{该内容于2021-04-28由reprex package (v0.3.0)创建}

如果您对中间列感兴趣，那么我在Github上有一个叫做{dplyover}的包，可以循环遍历向量以创建具有良好命名的列。它的性能不是很高，但查看基准测试似乎表现还不错（请参见以下基准测试）。

library(dplyover) # https://timteafan.github.io/dplyover/

 foo %>% 
    group_by(group) %>% 
    mutate(over(dates,
                ~ sum(.x >= datdeb & .x <= datfin),
                .names = "size_date{x}"))

#> # A tibble: 1,000,000 x 16
#> # Groups:   group [1,000]
#>       id datdeb datfin    etp group size_date31 size_date59 size_date90
#>    <int>  <dbl>  <dbl>  <dbl> <dbl>       <int>       <int>       <int>
#>  1     1    233    234 0.0322   581          82         154         218
#>  2     2    185    305 0.452    956          97         171         221
#>  3     3    237    281 0.0410   735          90         162         232
#>  4     4    255    290 0.290    646          86         159         222
#>  5     5     57    215 0.762    748          78         156         245
#>  6     6     42    218 0.343    243          80         154         215
#>  7     7     52     66 0.329    238          75         145         215
#>  8     8    138    158 0.724    681          81         150         221
#>  9     9     19    135 0.285    542          87         172         235
#> 10    10    300    330 0.0665    61          79         151         212
#> # … with 999,990 more rows, and 8 more variables: size_date120 <int>,
#> #   size_date151 <int>, size_date181 <int>, size_date212 <int>,
#> #   size_date243 <int>, size_date273 <int>, size_date304 <int>,
#> #   size_date334 <int>

^{这是由reprex包（v0.3.0）于2021年4月28日创建的}

这是我的data.table方法，但我认为还有更好的方法来完成它，也许其他用户在这里可以提供帮助。

foo_dat <- as.data.table(foo)

foo_dt[, paste0("size_date", 1:11) := lapply(dates,
                                             function(x) {
                                               sum(x >= datdeb & x <= datfin)
                                       }),
       by = group
       ][,
         .(m_size = rowMeans(.SD)),
         by = group,
         .SDcols = paste0("size_date", 1:11)
       ][,
         .(m_size = mean(m_size)),
         by = group
       ]

基准测试

以下是四种方法的基准测试结果：原始的loop、map、over和data.table。我在循环中遇到了一些问题，因此我包含了foo <- foo2来撤销更改。为了公平起见，我也添加了类似的行，虽然不是必要的，但对于其他三种方法也是如此。 over比预期的快得多，但仍然远远没有真正高效。诚然，我的data.table方法并不是真正高效的。在data.table中肯定有更好的方法可以做到这一点，速度应该会更快。

library(tidyverse)
library(lubridate)
library(dplyover) # https://github.com/TimTeaFan/dplyover
library(data.table)


dates <- yday(ceiling_date(dmy(sapply(1:11, function(x) paste0("01/", x, "/2009"))), "month") %m-% days(1))

foo <- data.frame(id = 1:1000000) %>%
  mutate(
    datdeb = round(runif(n(), 1, 365)),
    datfin = round(runif(n(), datdeb, 365)),
    etp = runif(n()),
    group = round(runif(n(), 1, 1000))
  )

foo_dt <- as.data.table(foo)
foo2 <- foo

test <- bench::mark(iterations = 50L, check = FALSE,
            
            "loop" = {

              for(i in 1:11){
                foo <- foo %>%
                  group_by(group) %>%
                  mutate(
                    "size_date{i}" := sum((.env$dates[i] >= datdeb & .env$dates[i] <= datfin))
                  )
              }

              foo %>%
                mutate(
                  m_size = rowMeans(across(starts_with("size_date")))
                ) %>%
                group_by(group) %>%
                summarise(
                  m_size = mean(m_size)
                )

              foo <- foo2
            },

            "map" = {

              foo2 %>%
                group_by(group) %>%
                mutate(m_size = rowMeans(
                  map_dfc(set_names(dates, dates),
                          ~ sum(.x >= datdeb & .x <= datfin))
                )
                ) %>%
                summarise(m_size = mean(m_size))
              foo <- foo2
            },

            "over" = {

              foo2 %>%
                group_by(group) %>%
                mutate(m_size = rowMeans(
                  over(dates,
                       ~ sum(.x >= datdeb & .x <= datfin),
                       .names = "size_date{x}")
                )
                ) %>%
                summarise(m_size = mean(m_size))
              foo <- foo2
            },
            
            "datatable" = {
              foo_dt[, paste0("size_date", 1:11) := lapply(dates, function(x) sum(x >= datdeb & x <= datfin)),
                         by = group
              ][,
                .(m_size = rowMeans(.SD)),
                by = group,
                .SDcols = paste0("size_date", 1:11)
              ][,
                .(m_size = mean(m_size)),
                by = group
              ]
              
              foo <- foo2
            })

#> Warning: Some expressions had a GC in every iteration; so filtering is disabled.
  
test
#> # A tibble: 4 x 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 loop          1.45s    1.61s     0.627     727MB     3.95
#> 2 map        916.06ms 998.53ms     0.985     186MB     5.24
#> 3 over       649.82ms 701.65ms     1.37      186MB     4.29
#> 4 datatable  856.88ms 921.75ms     1.06      271MB     1.80

^{本文创建于2021年4月28日，使用reprex package (v0.3.0)。}