在 R 中从一个 function 创建多列（然后对它们进行平均）
[英]Creating multiple columns from one function (and then averaging over them) in R
问题描述
从...开始：
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")))
)
不出所料，最后一个选项要快得多。
我想知道是否有更快（更优雅？）的方法来完成这项工作？ 特别是，是否可能以智能方式将这两个步骤与增量累积平均值结合起来？ 谢谢！
1 个解决方案
解决方案1
1 2021-04-28 17:29:39
我有一种更优雅的方式，但我怀疑它是否真的很高效。 一种方法是使用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
由代表 package (v0.3.0) 于 2021 年 4 月 28 日创建
如果您对中间列感兴趣，那么我在 Github 上有一个名为 {dplyover} 的 package ，它可以遍历向量以创建命名良好的列。 它的性能不是很好，但是从基准测试来看，它的表现似乎还不错（请参阅下面的基准测试）。
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>
由代表 package (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
由代表 package (v0.3.0) 于 2021 年 4 月 28 日创建
从一个函数计算多个列并将它们添加到data.frame
[英]Calculate multiple columns from one function and add them to data.frame
声明:本站的技术帖子网页，遵循CC BY-SA 4.0协议，如果您需要转载，请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.